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Introduction 

This document contains software listings of the SIFT operating system and 
application software. The software is coded foe the most part in a variant of 
the Pascal language, Pascal*. Pascal* is a cross-compiler running on the VAX 
and Eclipse computers. The ouput of Pascal* is BDX-390 assembler code. When 
necessary, modules were written directly in BDX-930 assembler code. The 
listings in this document supplement the description of the SIFT system found 
in Volume I of this report, "A Detailed Description". 
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MODULE SIFTDEC.COM 


const 

maxprocessors » 8; 

tasks =12; 

maxframe = 7 ; 

maxsub frame = 26; 

maxsched = 6; 

maxdata « 1015; 

maxtrans = 1023; 

maxdb =127; 

dbsize = 128; 

maxbinf = 200; 

maxbufs = 119; 

maxstate = 128; 

tentrysize = 5+maxstate; 

ttsize=tentrysize*(taaks+1 ); 

maxreconfig = 16#6FF; 

tpbase =896; 

eofbit = 1 6#8000; 

max window = 160; 


(* highest processor nt^nber *) 

(* number of tasks in the system *) 

(* Maximum frames in a cycle. '») 

(* last subframe in a frame *) 

(* highest schedule configuration *) 

(* highest address in the datafile *■) 

(* highest address in the trans. file *.) 

(* highest address in a databuffer *) 

(* size of a databuffer *) 

(■* maximum size of buffer information table *) 
(* maximum number of buffers, 4) 

(* largest number of items in a stateveotor *) 
(* size of a task entry *) 

(* size of the task table. *) 

(* maximum size of schedule table (1791) *) 

(# minimum value of the transaction pointer *) 
(* end of file £it for transaction *) 

(* length of window in clock task (250)*) 


(* the following are constants to be used when refering to buffers. *) 

(* reserved buffers *) 

r_0=0; r 1=1; r 2=2; r 3=3; r 4-4; r 5=5; r_6=6; r 7=7; r_8»8; 
r_9=9; r_10=10;"rJ1=lT; r_12=12; rJ 3 = 13 ; rj4=l4r rJ5=15; rj6*V6; 

(* unused buffers *) 

u 1 7=17; u_18=18; uJ9«19; u_20=20; u_21=21; u_22=22; u_23=23; U_24»t24; 

u_25=25; u_26=26; u~27=27 ; u_28=28; u_29=29; u~3u=3Q; u_31-31; 

(* system buffers *) 

errerr=33; 

gexecreconf =34; 

gexecmemory=35; 

expected=36; 

lock=37; 

ndr=38; 

xreset=39; 

(* redundant 1553a data is input into a,b or c buffers 
for p's 1,2 and 3 respectively *) 

astart=40; (* must correspond to first of a series *) 

aalpha=40; abeta*4l; acmdalt-42; acmdhead-43; adisfcanee»44; 
aglideslope=45; alocaiizer-46; ap=47; aphi=48; aphitrn-49; 
apsi=50; aq=51 ; ar»52; aradius=53; arturn=54; atheta=55; 
au=56; ax3=57; axontr=58j ay3“59; aycntr-60; 
alast=60; (* must correspond to last of a series *) 
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balpha=61; bbeta-62; bcmdalt-63; bcmdhead=64; bdistance*65; 
bglideslope=66; blocalizer-67; bp=68; bphi-69; bphitrn-70; 
bpsi=71; bq=72; br-73; bradius-7 1 *; brturn-75; btheta-76; 
bu=77; bx3-78; bxcntr-79; by3=80; bycntr»8l ; 

calpha=82; cbeta-83; ccmdalt-84; ccmdhead-85; cdistance-86; 
cglideslope-87; clocalizer-88; cp=89; cphi»90; cphitrn»91 ; 
cpsi=92; cq»93; cr-9 1 !; cradius=95; erturn»96; ctheta=97; 
cu=98; cx3"99; cxcntr-100; cy3»101; cycntr-102; 

(* The o series are the 1553a output values. *) 

ostart=103; (* must correspond to first of o series *) 

oemdail=103; ocmdele-104; ocmdrud-105; ocmdthr-106; 
odely=107; odelz-108; opitmo-109; olatmo-110; oreconf«1 1 1 ; 
olast=111; (* must correspond to last of o series *) 

osynch=1 1 2; 

(* Internal values. *) 

phin-113; psin«1lH; rn-115; 

qx=1 1 6; qy=117; qz«1l8; timer-119; 

(* end of buffer definitions *) 

(* 1553a constants ») 


appnum = timer-ostart+1 ; 

(* 

number of 1553 broadcast buffers *) 

onum = ostart; 

(* 

beginning of saved region #) 

numl 553a=ala3t-astart+1 ; 

(* 

number of items to read ») 

onum1553a=olast-ostart+1 ; 

(* 

number of items to write *) 

basl 553a=tpbase+astart; 

(* 

first input location *) 

masl 553a=1 6#00FF ; 

(* 

status bits *) 

outl 553a=olast-ostart+1 ; 

(* 

number of items to transmit *) 

obas1553a=tpbase+ostart; 

(* 

first output location. *) 

sa0=0; 

<* 

subaddress 0*) 

sal =1 6#20; 

(* 

subaddress 1*) 

red 553a-1 6#M00; 

(* 

Receive *) 

tra1553a-0; 

(* 

Transmit *) 

rtl =1 6#800; 

(» 

remote terminal 1 *) 

sbasl 553a-tpbase+osynch; 

(« 

synch word. *) 


(* the following constants are to be used when refering to task_ids. *) 


zerot=0; 

(* 

the zero task *) 


nullt=1 ; 

C* 

the null task *) 


clktid=2; 

(* 

the clock task *) 


ic1id=3; 

(* 

ic task 1 *) 


ic2id=i»; 

(* 

ic task 2 ») 


ic3id=5; 

(• 

ic task 3 *) 


errtid-6; 

(* 

the error task *) 


f itid=7; 

(* 

the fault isolation task 

*) 

rcftid=8; . 

(* 

the reconfiguration task 

*) 
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MODULE SIFTDEC.TYP 

type 

df index-0. .maxdata; (* data file *) 

dftype-array[df index] of integer; 

tpindex-0. .maxtrans; (* transaction file *) 

tftype-array[tpindex] of integer; 
processor-1 . .maxprocessors; (* processor *) 

procint-array[processor] of integer; 
procbool-arrayCproeessor] of boolean; 

buffer-0. .maxbufs; (* one for each buffer. *) 

buf int=array[buffer] of integer; 
bufrec-record 
dbx: integer; 
adiprocint; 
end; 

statevector-arrayCO. .maxstate] of integer; 
sched_call-(tasktermination, clock interrupt, systems tar tup) ; 
taskentry-record 

status :sched_call; (* cause of the last pause. #) 
bufs: integer ; (* ptr to list of bufs broadcasted. *) 

errors: integer; (* Number of task overrun errors. *) 

stkptr: integer; (* last stack pointer *) 

state: statevector; (» stack for task *) 
end; 

task=0. .tasks; (* one for each task. ») 

db index-0. .maxdb; (* data buffer ») 

bitmap-0.. 255; (* vector of bits 0..7 *) 

schindex-O. .maxreconf ig; (* schedule table index *) 
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MODULE SIFTDEC.GLO 

(* the following constants specify the absolute addresses of the fixed 
data structures. Some data structures are fixed due to hardware 
constraints. Others are global varibales, and fixing their address 
is the only way to reference them globally. *) 

(* note siftdec.glo supplies the global symbols to Pascal modules. File 
globals.sr supplies the linker with symbol names for these locations. 
Both files should be maintained *) 


(* Address of transaction file. *) 

(* Address of global frame count #) 
(* Address of subframe count *) 

(* Address of dbad. *) 

(* Address of rpcnt *) 

(* "Exec Stack" location - siftih *) 
(* Address of tt. *) 

(* Address of bt. *) 

(# Address of numworking. *) 

(* Address of pid. *) 

(* Address of vtor. *) 

(* Address of rtov. *) 

(* Address of post vote buffer. *) 

(* Address of scheds. *) 

(* Address of datafile. *) 

(* Address of pideof. *) 

(* Address of trans pointer. *) 

(* Address of sta1553a. *) 

(# Address of real time clock. *) 

(* Address of cmd1553a. *) 

(* Address of adr1553a. *) 

(# Address of buffer info. *) 


var (* the fixed address variables *) 

(* pre-initialized tables #) 

tt at tloc: arrayCtask] of taskentry; (* Task Table *) 

scheds at sloe: array[schindex] of task; (* schedules *) 

binf at iloc: array[0. .maxbinf ] of buffer; (* list of tasks' buffers *) 

(* hardware constrained variables *) 

transfile at tfloc: tftype; 
datafile at dfloc: dftype; 

pideof at pfloc: integer; (* processor ID discrete (read) *) 

transptr at tploc: integer; (* transaction pointer *) 

sta1553a at s151oc: integer; (* 1553a status register ») 

clock at elkloe: integer; (* real time clock (read/write)*) 


const 

tfloc=l6#3 1 *00; 
gfrlc=l6#3800; 
sfclc=l6#3801; 
dbloc=l6#3802; 
rploc=1 6#38l 0; 
stackloc=1 6#5000; 
tloc=l6#5500; 
bloc=l6#6000; 
numloc-1 6#6800; 
pidloc=l6#6801 ; 
vtorloc=1 6#6802; 
rtovloc=1 6#680A; 
pvloc=1 6#6840; 
sloc-l6#6DOO; 
dfloc=l6#7400; 
pfloc- 16#77F8; 
tploc- 16#77F9; 
s151oc«16#77F9; 
clkloc=l6#77FB; 
c151oc-16#77FD; 
al 51oc- 1 6#77FF ; 
iloc-l6#7800; 
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cmd1553a at c151oc: integer; (* 1553a command register #) 

adr1553a at a151oc: integer; (* 1553a address register ») 

(*' global variables *) 

gframe at gfrlc: integer; (* global frame count *) 

sf count at sfclc: integer; (* sub frame count *) 

rpcnt at rploc: integer; (* subframe repeat counter *) 

postvote at pvloc: bufint; (* post vote buffer ») 

dbad at dbloc: procint; (# index to start of data buffer *) 

bt at bloc: arrayCprocessor ,task] of bitmap; (* task bit map *) 

pid at pidloc: processor; (* My processor number *) 

numworking at numloc: processor; (* Number of working processors 1 . .8 *) 

vtor at vtorloc: arrayCprocessor] of processor; 

(* Virtual to real processor numbers *) 
rtov at rtovloc: arrayCprocessor] of processor; 

(* Real to virtual processor numbers *) 
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MODULE SIFTOP.MCP 


PROGRAM SIFTOPERATINGSYSTEM; 

include 'siftdec.con' ; 
include 'siftdec.typ' ; 
include 'siftdec.glo' ; 


var 

working: procbool; (* 
errors: procint; (# 
vl ,v2,v3,v4,v5: integer; (* 
pi fPS.pS.P^.pS: processor; (* 
taskid: task; (* 
presentconfig: bitmap; (* 
tp.vp, (* 
tpi.vpi: schindex; (* 
framecount: integer; (* 
pclock.cclock.aclock: integer; (* 
skew: procint; (* 
delta: integer; (* 
window: integer; (* 


power2: arrayCprocessor] of bitmap; 

(* 

vtodf: arrayCprocessor] of dflndex; 

(* 

nw: processor; (* 


Working processors *) 
voting *) 
more voting *) 
still more voting #) 

Number of currently running task *) 

The present configuration *) 
schedule pointers(i.e, task, vote *) 
start of schedule pointers *) 

The current frame count *) 
globals for clock synchronization *) 
array for clock synchronization *) 
correction applied to clock *) 

For timing the window in clktask *) 

power2[p] :» 2**p *) 

virtual processor to datafile address *) 
number working processors 1..8 *) 


(* procedure to initialize task statevector *) 

PROCEDURE REINIT(VAR S:SCHINDEX; VAR V : STATEVECTOR ) ; EXTERN; 

PRXEDURE ICINIT; EXTERN; (* initialize interactive consistency tasks *) 

PROCEDURE APPINIT; EXTERN; (* initialize applications task *) 

PROCEDURE PAUSE( I: INTEGER); EXTERN; (* halt with i in R1 *) 

PROCEDURE WA IT (X: INTEGER); EXTERN; (* wait x seconds *) 

(*####***** GPROCESSOR **********) 


PROCEDURE GPROCESSOR; 

(* Set the processor pid as a number between 1 and maxprocessor. *) 
begin 

pid :- ((pideof div 4000B) band 16#0F); 
end; (* GPROCESSOR *) 
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(##**#*###* DBADDRS #****#**##) 


PROCEDURE DBADDRS; 

(* calculate the index of the start of each of the databuffers. *) 
var 

p; processor; 
ad: df index; 

begin 

ad :» 0; 

for p 1 to pid-1 do 
begin 

dbad[p] ad; 

ad := ad+dbsize; (* - 128 *) 
end; 

for p pid+1 to maxprocessor do 
begin 

dbadCp] ad; 

ad :» ad+dbsize; 
end; 

dbadtpid] ad; (* this processors output area *) 
end; (* DBADDRS *) 


(###*#»##** BROADCAST **********) 

GLOBAL PROCEDURE BROADCAST (B: BUFFER ) ; 

(# Broadcast buffer b. This is provided for applications tasks, and 
those executive tasks that don't do it themselves. *) 


var 

dbx.tp: dfindex; 


begin 

dbx b; tp :« dbx+tpbase; 
while pideof < 0 do; 

transf ile[2*tp-1023] eofbit bor dbx*8; 

transptr :■ tp; (* initiate the broadcast. *) 

end; (* BROADCAST *) 
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(#**#***#*# STOBROADCAST **********) 

global procedure stobroadcast(b: buffer; v: integer); 

(* Store v in buffer b and broadcast it. *) 

var 

dbx: buffer; 
tp; df index; 

begin 

dbx := b; tp := dbx+tpbase; datafile[tp] := v; 
while pideof<0 do; 

transf ile[2*tp-1 023] : = eofbit bor dbx*8; 
transptr := tp; (* initiate the broadcast. *) 

end; (* STOBROADCAST *) 

(«**#»##*** WAITBROADCAST **********) 

GLOBAL PROCEDURE WAITBROADCAST; 

(* Wait for a broadcast operation to complete. *) 

begin 

while pideof<0 do; 
end; (* WAITBROADCAST *) 


(»*»«****** WORK **********) 


PROCEDURE WORK; 

(* At startup, identify which processors are nominally working. *) 
var 

p: processor; 


begin 

(* set buffer r_0 to -1 for all procs *) 

for p := maxprocessors downto 1 do datafile[dbad[p]] :» -1 ; 
wait( 1) ; 

(* send my pid *) 
stobroadcast(r_0,pid) ; 
wait( 1) ; 

(* now see who's there *) 
for p ;= maxprocessors downto 1 do 
if dataf ile[dbad[p]] = p then 
working[p] true 
else working[p] := false; 
working[pid] := true; (# I'm working #) 

end; (* WORK *) 
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(*»**»*»**» SYNCH **********) 


GLOBAL PROCEDURE SYNCH; 

(* At startup synchronize the processors. Highest number processor sends 
start signal *) 

const 

value - 16#FOOO; 


var 

p: processor; 
jj df index; 


begin 

p maxprocessors; 

while not workingCp] do p :« p-1 ; 

(* i points to the highest working processor. *) 

j :■* dbad[p]; 
datafileCj] 0; 
if p - pid then 
begin 

wait(1); (* wait a second *) 

stobroadcast(r_0, value); (* send signal *)■ 
waitbroadcast; (* wait for completion *)■ 

end 

else while datafileCj ]<>value do; (* wait for signal *) 
end; (* SYNCH *) 

(*»*****»»» pail **********) 


PROCEDURE FAIL; 

(*' All returned values are wrong, so report all processors involved. 
This could be coded inline, but it would take too much room. The 
minor additional time that it takes to call the subroutine is 
probably worthwhile. Especially since we'll probably never use it! r ) 


begin 

errorstpl ] errorsCpI ]+1 ; 
errors[p2] :« errors[p2]+1 ; 
errors[p33 :» errors[p3]+1 ; 
errors[p4] :« errors[p4]+1 ; 
errors[p5] :* errors[p5] + 1 ; 
end; (♦ FAIL *) 

(»**«*«»*** ERR »*»*****»*) 


PROCEDURE ERR(P: PROCESSOR); 

(* Record an error for processor p. *) 


begin 

errorsCp] errors[p]+1 ; 
end; (* ERR *) 
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(****»***«» VOTE 5 *«***#*»*») 

FUNCTION V0TE5 (DEFAULT: INTEGER): INTEGER; 

(* This is the five way voter. Default is returned in the 
case that there is no majority value. *) 

begin 

if vl - v2 then 

if vl - v3 then 

begin vote5 vl; 

if vl <> v4 then err(p4); 
if vl <> v5 then err(p5); 
end 

else 

if v2 = v4 then 

begin vote5 := vl; err(p3); 

if vl <> v5 then err(p5); 
end 

else 

if vl - v5 then 

begin vote5 vl; err(p3); err(p4); end 

else 

if v3 - v4 then 

if v3 » v5 then 

begin vote5 :■ v3; err(pl); err(p2); end 

else 

begin vote5 :■ default; fail; end 

else 

begin vote5 :» default; fail; end 

else 

if vl - v3 then 

if vl - v4 then 

begin vote5 :■ vl ; err(p2); 
if vl <> v5 then err(p5); 
end 

else 

if vl ■ v5 then 

begin vote5 s- vl ; err(p2); err(p4); end 

else 

if v2 - v4 then 

if v2 = v5 then 

begin vote5 := v2; err(pl); err(p3); 

else 

begin vote5 := default; fail; end 

else 

begin vote5 default; fail; end 


end 
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else 

if v*l - v5 then 

if v2 » v4 then 

begin vote5 : = v2; err(pl); 
if v2 <> v3 then err(p3); 
end 

else 

if vl = v5 then 

begin vote5 vl; err(p2); err(p3); end 

else 

if v3 = v5 then 

begin vote5 := v3; err(pl); err(p2); end 

else 

begin vote5 default; fail; end 

else 

if v2 = v5 then 

if v2 = v3 then 

begin vote5 v2; err(pl); err(p4); end 

else 

begin vote5 := default; fail; end 

else 

if v2 = v3 then 

if v2 = vM then 

begin vote5 :=* v2; err(pl); err(p5); end 

else 

begin vote5 :* default; fail; end 

else 

begin vote5 := default; fail; end; 

end; (* VOTES #) 


(««*******» VOTE 3 **********) 

FUNCTION V0TE3(DEFAULT: INTEGER): INTEGER; 

(* This i3 the 3 way voter. It assumes that VI . . V3 contains 
the 3 values to be voted, and that PI . . P3 contains the 
processor numbers. #) 

begin 

if vl - v2 then 

begin vote3 := vl; 
if v1<>v3 then err(p3); 
end 
else 

if vl = v3 then 

begin vote3 := vl ; err(p2); end 

else 

if v2 = v3 then 

begin vote3 v2; err(pl); end 

else 

begin vote3 := default; err(pl); err(p2); err(p3); 
end; (* V0TE3 *) 


end; 
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(«***#**»** VOTE *****»#*»*) 

PROCEDURE VOTE(TK: TASK; DEFAULT: INTEGER); 

(* vote task tk. Get task processor bitmap (set P1..P5). Then vote all 
task's buffers. This involves either five way or three way voting. *) 

var 

i,j, preal: processor; 
k: bitmap; 
b: buffer; 

dl f d2,d3,d4,d5: df index; 
lbufs: integer; 

begin 

j 0; i :- 1; 

k :- bt[nw,tk]; (* k - processor bitmap of task tk *) 

repeat 

if odd(k) then (* then proc i produced task tk *) 

begin 
j :» j+1 ; 

preal :» vtor[i]; (* use real numbers for errors array access *) 
case j of 

1 : begin PI : -preal; D1 :-vtodf [i]; end; 

2: begin P2: -preal; D2:-vtodf [i]; end; 

3:begin P3:=preal; D3:»vtodf[i]; end; 

^4 : begin P4: -preal; D4:-vtodf[i]; end; 

5:begin P5:»preal; D5: -vtodf [i] ; end; 
end; (* case ») 

end; 

k k div 2; 

i i+1 ; 

until i > maxprocessors; 

lbufs :» tt[tk].bufs; (* location task's buffer information *) 

b binf [lbufs]; (# first buffer *) 

if j < 3 then (* no vote *) 

while b>0 do 

if j>0 then (* use Pi's value *) 

begin 

postvote[b]:» datafile[D1 + b]; 
datafile [tpbase + b]:« postvoteCb]; 
lbufs: -lbufs+1 ; 

b: -binf [lbufs]; (* next buffer *) 
end 

else 

begin 

postvote[b]:= default; 

datafile [tpbase + b]:» postvote[b]; 

lbufs: -lbufs+1 ; 

b: -binf [lbufs]; (* next buffer *) 
end; 
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else 

if j<5 then 
while b>0 do 
begin 

VI :»dataf ile[D1+b] ; 

V2: -dataf lle[D2+b]; 
V3:-datafile[D3+b]; 
postvoteCb] :-vote3(default) ; 
dataf ileCtpbase+b] : -postvoteCb] ; 
lbufs:-lbufs+1 5 

bj-binfClbufs]; (* next buffer *) 
end 

else 

while b>0 do 
begin 

VI : -dataf ileCD1+b]; 

V2: -dataf ileCD2+b] ; 

V3: -dataf ile[D3 + b] ; 

V4: -dataf ileCD4+b] ; 

V5; -dataf ile[D5+b]; 
postvoteCb] :-vote5(default) ; 
dataf ileCtpbase+b] : -postvoteCb] ; 
lbufss-lbufs+1 ; 

b:-binf[lbufs]; (* next buffer *) 
end; 

end; (» VOTE *) 


(##*##**»** GETVOTE »*»***»♦**) 

GLOBAL FUNCTION GETVOTE (B: BUFFER ) : INTEGER; 

(* the getvote function is how application task access the postvote 
array, this way they arent mapped to the postvote area. #) 

begin 

getvote postvoteCb]; 
end; (* GETVOTE *) 


(*####*#*»# VSCHEDULE ***#»*•***) 


PROCEDURE VSCHEDULE; 

(* Vote those items scheduled for this subframe. *) 


var 

tk: task; 
begin 

tk seheds[vp]; 
while tk>0 do 
begin 

vote(tk,-1 ) ; 
vp : - vp+1 ; 
tk scheds[vp] 
end; (* while *) 


(* get taskid to vote *) 

(* default - -1 »■). 

(* get next taskid *) 
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if tk >= 0 then vp :» vp+1;(# tk=-1 is end of schedule *) 
end; (* VSCHEDULE *) 


(***»*###** TSCHEDULE #******#»*) 


PROCEDURE TSCHEDULE; 

(» Find the next task to schedule. *) 

var 

tk: task; 


begin 

tk :» scheds[tp]; 
if tk - -1 then 
begin 

taskid nullt; 

rpcnt :« -2; 
end 
else 
begin 

taskid tk; 

tp tp + 1 ; 
rpcnt :« -scheds[tp]; 
tp tp + 1 ; 
end; 

end; (* TSCHEDULE *) 


(* end of schedule ») 

(# default to null task *) 

(* 2 ticks 3.2ms *) 

(* set up taskid #) 

(* load interrupt repeat counter *) 


(***#*#***# BUILDTASK *#**#***##) 

PROCEDURE BUILDTASK (TASKNAME: TASK); 

(* Initialize a task table entry *) 

begin 

reinit(tt[taskname] .stkptr ,tt[t as kname], state) ; 
tt[taskname] .status tasktermination; 
end; (* buildtask *) 
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(»******##* SCHEDULER **********) 

GLOBAL FUNCTION SCHEDULER ( CAUSE :SCHED_CALL; STATE : INTEGER ) : INTEGER 
(* save task stack pointer, if clock interrupt and not nullt task’ 
and hot zero task (system startup) and not suspendable then rebuild 
task, then get new subframe, next task, do vote, if task terimihatiori 
select nullt task, return new task stack pointer. *) 

begin 

tt[taskid] .stkptr : = state; 

if causeOtasktermination then (* clock interrupt *) 

begin 

if (taskidOnullt) then (* nullt can be interrupted *) 

if taskidOO then (* zero task is at system startup 

begin (* task overran, keep errdr eouht *)' 

tt[taskid] .errors := tt[taskid] .errors+1 ; 
pause (16#BAD0 bor taskid); 
buildtask(taskid) ; 
end 

else tt[taskid] .status :« clockinterrupt; 

if sf count >= maxsubframe then (* new frame *) 
begin 

if framecount >- maxframe then framecount 0 

else framecount :« framecount+1 ; 

gframe gframe+1; 

sf count 0; vp :«• vpi; tp tpi; 

end 

else sf count :« sfcount+1 ; 

tschedule; (# changes taskid arid rpcrit *) 

vschedule; (* the vote *) 

end 

else (* task termination start null task ») 

taskid := nullt; 

scheduler := tt[taskid] .stkptr; 

end; (* SCHEDULER *) 

(*#****#### NULLTASK **********) 

GLOBAL FUNCTION NULLTASK: INTEGER; 

(* This is the task that wastes time. It never terminates. In 
the final system the nulltask will be the diagnostic task. *) 

begin 

while true do (* loop forever *) 
end; (* NULLTASK *) 
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(#***#***#* ERRTASK **##*****#) 

GLOBAL FUNCTION ERRTASK: INTEGER; 

(* Compute and broadcast a word with bits 7 through 0 
indicating whether processors 8 through 1 have 
failed (1) or are ok (0). *) 

const 

threshold = 3; 

var 

err: bitmap; 
i: processor; 

begin 

err := 0; i :» maxprocessors; 
repeat 

err : = err*2; 

if (not working[i]) or (errors[i]>threshold) then err :« err+1 ; 
errors[i] := 0; (* clear error count every frame *) 

i :» i-1 
until i < 1 ; 

s tobr oadcas t ( er rerr , err ) ; 
err task := 0; 
end; (* ERRTASK *) 


Page 17 



27 - JUN-85 The SIFT Hardware/ Software Systems - Volume II 

Software Listings 


(»*«»****** FAULTISOLATIONTASK **»»**»***) 
GLOBAL FUNCTION FAULTISOLATIONTASK: INTEGER; 

(* Compare values from the err tasks. Processors that are reported 
by two or more processors (other than itself) for more than 
one frame, are considered bad. The rest are considered good. 
The report consists of a word, bits 7 through 0 of which 
represent processors 8 through 1. (1 failed, 0 working.) *) 


var 

errpt: arrayCprocessor] of bitmap; 
bitest, reconf: bitmap; 
pi ,pj : processor; 
count: integer; 

begin 

(* load all error reports from the datafile *) 

for pi := 1 to maxprocessor do errpt[pi] := dataf ile[dbad[pi] + errerrj; 

reconf :- 0; (* start with everyone working *) 

bitest :- 1 ; (* processor 1 - bit 0, .. *) 

for pi :» 1 to maxprocessor do (* is pi faulty ? *) 

begin 

count := 0; (* to count # of pi's accusers *) 

for pj := 1 to maxprocessor do (* ask pj if pi faulty *) 

if workingtpj] then (* only if pj working, and *) 

if pj <> pi then (* pj isn't pi ! #) 

if (errpt[pj] band bitest) > 0 then (* test *) 
count :=* count + 1; (* count em *) 

if count > 1 then reconf :=* reconf + bitest; (* if > 1 marfreftt bard *) 
bitest :» bitest*2; (* look at next pi *) 

end; 

(* remove processor if faulty for two consecutive frames *) 

(* send resultant configuration word *) 

stobroadcast(gexecreconf .reconf band postvote[gexecmemory]); 
waitbroadcast; 

stobroadcast(gexecmemory .reconf ); (* remember this frame's result *) 

faultisolationtask := 0 
end; (* FAULTISOLATIONTASK *) 
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(a#*****##* CLRBUFS **********) 


PROCEDURE CLRBUFS; 

(* Set the buffer table so that no assumptions are made about what 
processor is computing the task. *) 


var 

p: processor; 
tk: task; 

begin 

for p := 1 to maxprocessors do 
for tk:= 0 to tasks do 
bt[p,tk] := 0; 
end; (* clrbufs #) 


(****###*## RECBUFS **********) 
procedure recbufs(nwk,p: processor; s: schindex); 

(* s points to the task schedule corresponding to virtual processor p. 
Figure out which buffers the processor will compute and mark its bit in 
the bt array, the voter will use the resulting bit map to figure where 
in the datafile to find good data to vote ») 


var 

t: task; 


begin 

s :« s+3; 

while scheds[s]<>-1 do 

if schedsCs] - nullt then (* repeat count would follow *) 
s := s+2 
else 
begin 

t schedsCs]; 

bt[nwk,t] bt[nwk,t] bor power2[p]; 

s :» s + 2; (# next task, skip repeat count *) 

end; 

end; (* recbufs *) 
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(a**#***##* XRECF ##*#******) 

FUNCTION XRECF (RECONF ; BITMAP): INTEGER; 

(* from reconf compute working and real to virtual map (rtov) virtual 

to real map (vtor) , virtual to datafile offset and number working (nw) . 
get schedule pointers according to nw. This is done even if 
configuration hasn't changed to insure validity of the local variables *) 

var 

p: processor; 
s: schindex; 
r: bitmap; 

begin 

nw :« 0; p :■ 1; r reconf; 

repeat (* rebuild local configuration dependent data *) 

if odd(r) then (* not working *) 

begin 

working[p] := false; 
rtov[p] :» maxprocessors; 
end 

else (* working *) 

begin 

working[p] true; 
nw := nw+1 ; 
vtorCnw] :« p; 
rtov[p] nw; 
vtodf[nw] dbad[p]; 
end; 

r :» r div 2; 

p p+1 ; 

until p > maxprocessors; 

presentconf ig := reconf; (* configuration might not have changed *) 
dataf ile[tpbase+oreconf ] :*■ reconf; 

s 0; (* find schedule for.. *) 

while scheds[s]Onw do s s+scheds[s+2] ; (* current number working *) 

tpi:-0; p := 1 ; 

repeat 

if vtor[p] = pid then tpi := s+3; (* and in particular, met *) 

s s+scheds[s+2]; 

p : * p+1 
until p > nw; 

if tpi=0 then pause ( 16#F00B) ; (* i've been reconfigured out, oh well *) 

s := s+3; vpi := s; (* establish vote schedule pointer *) 

numworking :» nw; (* some procedures use numworking *) 

xrecf 0; 
end; (* XRECF *) 
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(**####**## reCFTASK **«#*#«***) 

GLOBAL FUNCTION RECFTASK: INTEGER ; 

(* The reconf iguration task calls xrecf to do the real work. Initialization 
procedure calls xrecf also *) 


begin 

recftask := xrecf (postvote[gexecreconf ] ) 
end; (* RECFTASK *) 
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(******#### CLKTASK ##*******») 

PROCEDURE ENABLE; EXTERN; (* To enable and disable the clock *) 

PROCEDURE DISABLE; EXTERN; (* interrupt *) 


GLOBAL FUNCTION CLKTASK: INTEGER; 

(* each working processor has a window within which he’s expected to 
broadcast his clock, everyone else is waiting for him. when 'seen' 
they compute the skew, if they time out he's unseen, the clock is then 
updated according to the mean skew, p.s., you have to use global 
variables when playing with the clock or the compiler might optcmize 
your algorithm away *) 

const 

omega » IB 1 *; 
commdelay = 24; 
clk_buf - 16#8000; 
clk_trans - 769; 

var 

p: processor; 
num, sum, term: integer; 
x: df index; 
epsilon: integer; 

begin 

disable; (* dont get interrupted during transfer *) 

(* or clock correction *) 

for p := maxprocessors downto 1 do dataf ile[dbad[p] ] := 0; 
transfile[clk_trans] : = clk_buf; (* set transaction file *) 

for p := maxprocessors downto 1 do (* every p has a window in *) 

begin (* which to broadcast his clock *) 

skew[p] := 0; 
window: -clock; 


(* above which the skew is ignored - 209*) 

(* expected communications delay - 38.4*) 

(* offset 0 in datafile *) 

(* 2*tpbase-1 023, trans file address for elk buf * V 


If p * pid then 
repeat 

if pideof>0 then 
begin 

dataf ile[tpbase] :-clock; 
transptr: -tpbase; 
end; 

until clock-window > max window 


(* this is my window *) 

(* the Broadcast *) 

(* wait for completion *) 

(* read clock *) 

(* its that simple *) 
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} 

begin 

(* 

look for other p *) 

x:»dbad[p]; 

(* 

p's clock buffer *) 

pclock := datafile[x]; 

(* 

current value *) 

repeat 

(* 

wait until it changes *) 

cclock := datafile[x]; 

(* 

new value arrived?? *) 

aclock: -clock; 

<* 

my clock *) 

if cclock <> pclock then 

(* 

cclock is new value *) 

begin 

(* 

calculate skew.. *) 


skew[p]:= cclock + commdelay - aclock; 

repeat (* wait till next window *) 

until clock - window > max_window; 

end; 

until clock-window > max_window; 
end; 

end; 


(* Calculate the clock correction. *) 

sum : = 0; num : = 0; 
for p := 1 to maxprocessors do 
begin 

if working[p] then 
begin 

term :» skew[p]; 

if term > omega then term 0; (* too high *) 

if term < -omega then term :« 0; (* too low *) 

sum : - sum* term; 
num : - num+1 ; 
end 

end; 

delta := (sum div nian); (* the correction is simple average *) 


cclock := delta+clock; 

clock :» cclock; (* Adjust the clock value. *) 

enable; (* ok now *) 

clktask :« 0; 
end; (* CLKTASK «) 
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(****»#***# INITIALIZE #«**#*****) 

GLOBAL PROCEDURE INITIALIZE; 

(# initialize system state variables *) 

var 

p,nwk: processor; 
s: schindex; 
r.reconf; bitmap; 
b; buffer; 
tk: task; 
i: integer; 


begin 

(* who am i, where are the datafile buffers, whose working, sync up #) 
gprocessor; dbaddrs; work; synch; 

clrbufs; (* clear the bt array *) 

(* create power of 2 array #) 
r :« 1 ; 

for p :» 1 to maxprocessor do (* build power of 2 array #) 
begin 

power2[p] := r; 
r := r*2; 
end; 

(* compute bt array for every configuration #) 
s := 0; 

for nwk := 1 to maxsched do 
begin 

while scheds[s] <> nwk do s := s + scheds[s+2]; 

(* s := schedule for nwk *) 
for p :■ 1 to nwk do 
begin 

recbufs(nwk,p,s); (* fill bt *) 

s s + scheds[s+2]; 

end; 

end; 

synch; (* that took a long time lets resynch *) 

(* set some variables *) 
presentconf ig := 0; reconf := 0; 

gframe := 0; framecount := 0; sf count := maxsubframe; 

rpcnt := -2; taskid := zerot; (* zero task gets clock interrupt *) 

clock :=■ 0; 
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(* clear postvote buffer *) 

for b :■ 0 to maxbufs do postvoteCb] 0; 

(* build task state vectors *) 
for tk 0 to tasks do 

begin buildtask(tk); tt[tk], errors 0 

end; 

(* etablish initial configuration *) 

for p :» maxprocessors downto 1 do 
begin 

errors[p] :» 0; 
reconf :« reconf*2; 

if not workingCp] then reconf :« reconf +1 
end; 

postvoteCgexecmemory] reconf; (* set the transient filter *) 

i :■ xrecf (reconf ) ; (* reconfigure *) 

appinit; (« do application initialization ») 

icinit; (* and interactive consistency *) 

end. (* INITIALIZE, SIFTOPERATINGSYSTEM *) 
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MODULE SIFTIC.MCP 


PROGRAM IC; 

(* This module performs the Interactive Consistency algorithm. Ictl obtains 
new data from the 1553a bus and broadcasts the data. Ict2 rebroadcasts the 
data. Ict3 votes the replicates and places the results in the POSTVOTE array. 
Some complications are included due to the realities of this implementation. 
The 1553a data (aircraft sensor data) is computed by a simulation running on 
the Eclipse 250. The Eclipse doesn't always respond in time. To keep the SIFT 
in action (i.e. to avoid a waitfor loop), we save the current iteration's 
POSTVOTE data, "lock" the outputs and use random data until the "new data" is 
available from the Eclipse. When we have new data the POSTVOTE area is 
restored and the output function is unlocked *) 

include ' siftdec.eon' ; 
include 'siftdec.typ' ; 
include ' siftdec.glo' ; 

const 

reset = -1 ; 


type 

replicate = 1 . .3; 


var 

expndr .ready ,oldexpected: integer; (* globals for ictl ») 
index: dfindex; 
base: buffer; 
seed.bclock: integer; 

tempvote: array [0. .appnum] of integer; (* ict3: temporary storage *) 
vp:array[replicate] of processor; (» ict3: vitual processor array *) 


PROCEDURE BROADCAST^: BUFFER); EXTERN; 

PROCEDURE STOBROADCAST(B: BUFFER; V: INTEGER) ; EXTERN; 
PROCEDURE WAITBROADCAST; EXTERN; 

PROCEDURE PAUSE( I: INTEGER); EXTERN; 

FUNCTION GETV0TE(Q: BUFFER): INTEGER; EXTERN; 
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(*»**»«*«»x iqti »»*««»***») 

GLOBAL FUNCTION ICT1 -.INTEGER; 

(* When output is available (unlocked), the data is sent to aircraft, 
all processors participating in iclt will test for arrival of new 
data. If data ready, receive it. if not use randomized data and 
lock output.*) 

(*»*»****»* RANDOMIZE ***»**»**») 

FUNCTION RANDOMIZE ( SEED: INTEGER ) : INTEGER; 
begin 

randomize := (25173*seed+1 3849) mod 65536; 
end; (* RANDOMIZE *) 

(»#*##»**»» C0MUN1 553A **********) 

PROCEDURE COMUN 1 553A ( ADR , N , SA ,M0DE , RT : INTEGER ) ; 

(* N words, starting at ADR, are received from/transmitted to sub-address 
SA, remote-terminal RT, occording to MODE *) 

const errmask«l6#003F; (* bits 0-5 *) 
var i ,cmd: integer; 

(***»***#»» WAIT1553A **********) 

PROCEDURE WAIT1553A; 
begin 

while (sta1553a band mas1553a)-0 do 
end; (* WAIT1553A *) 

begin (* C0MUN1 553A*) 
cmd:-n+sa+ mode+rt; 
adrl 553a: -adr; 

cmdl 553a: -cmd; (* doit *) 

wait! 553; 

if errmask band sta1553a <> 0 then 
begin (* try again if needed *) 
adrl 553a: -adr; 

cmdl 553a: =cmd; (* requires 45 ♦ n*20 us *) 

waitl 553a; 

end 

else 

begin (* allow time for retransmit *) 
bclock: =clock; 

i:= 28 + n*( 12) ; (* clock tick * 1.6 us *) 

while clock-bclock < i do; 

end 

end; (* C0MUN1 553A *) 
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(*»«**»##»* GETNDR **«*»»*«»») 

PROCEDURE GETNDR; 

(* read new data flag, if ndr then broadcast 1 else broadcast 0. 
wait for other processors, while waiting we choose buffers for 
the data. *) 

var i: dbindex; 
val: integer; 
p: processor; 

begin 

(* set buffer area to negative indication *) 
for i:-1 to maxprocessors do dataf ile[dbad[l]] :»0; 

(* receive new data ready from Eclipse *) 
comuni 553a(sbas1 553a* 1 ,sa1 , red 553a, rtl ); 

val:«dataf ile[sbas1553a}; (* val - new data ready flag *) 

(* if ndr set posative indication for me *) 
if (val-expndr) or (val-reset) then dataf ile[tpbase]:-1 ; 

waitbroadcast; 

broadcast (r_0) ; (* let others know ») 

bclock: -clock; (* begin wait *) 

(* select buffer area for data *) 

(* get my virtual processor # *) 
p := rtov[pid]; 

if p > 3 then pause( 16#00C1 ) ; (* should only be three *) 

case p of (* 1,2,3 • a,b,c *) 

1 : base : - aalpha; 

2: base balpha; 

3: base calpha; 
end; 

index: -base+tpbase; 

while clock-bclock < Max__window do (* wait max skew *); 
end; (* (KTNDR *) 
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(*#***#***» GETREALDATA •#««****•») 

PROCEDURE GETREALDATA; 

(* lets all read the new data flag and then read air data *) 
begin 

comuni 553a(sbas1 553a, 1 , sal ,rec1553a,rt1 ) ; (* get ndr flag *) 

if dataf ile[sbas1 553a]-reset then (* reset mode if necessary «) 
begin 

stobroadca3t(xreset, 1) ; 

expndr: -reset; 

end 

else stobroadcast(xreset,0); 

comun1553a(index,num1553a,sa0,rec1553a,rt1); (* get air data ») 
stobroadcast(ndr, 1 ) ; (* unlock outputs #) 

end; (* GETREALDATA *) 

(#*»***#*** PROCEDURE GETRANDOMDATA ******«»*«) 

PROCEDURE CETRANDOMDATA; 

(* there was no new data ready, so, lets substitute random data and fly *) 

var i: df index; 

begin 

stobroadcast(xreset,0) ; 

expndr: -oldexpected; (* set to previous iteration *) 

seed: =gframe*maxsubframe+sf count; 

for i : = 0 to (num1553a-1) do (* subsititute random data #) 
begin 

seed :- randomize (seed); 
dataf ile[i+index] :- seed; 
end; 

stobroadcast(ndr ,0) ; (* lock the outputs *) 

end; (* GETRANDOMDATA *) 
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(**#***#**« PROCEDURE GETNEWDATA »**»**««*») 

PROCEDURE GETNEWDATA; 

(* if at least two processors have received the new data flag 
use real data, else use random data *) 

var p: processor; 

begin 

getndr; (* get ndr flag from Eclipse *) 

ready: -0; 

for p 1 to numworking do (* is anybody ready7? *) 
if dataf ile[dbad[vtor[p]]]-1 then ready ready +1; 
if (ready>-2) or ( (numworking<2) and (dataf ile[tpba»e]-1 ) ) 
then getrealdata 
else getrandomdata; 
end; (* GETNEWDATA *) 


PROCEDURE DISTRIBUTE; 

(* send data, real or random, to other processors *) 
const 

tfbase - 2*tpbase-1023; 

var 

b: buffer; tp: dfindex; bend: integer; 
begin 

bend := base + num1553a ~1 ; 
for b base to bend do 

transf ile[2*b+tf base] :=b*8; (* set transaction file *) 
waitbroadcast; 

(* last buffer gets eof *) 

transf ile[2* (bend) + tfbase]: -eofbit bor (bend*8); 
pideof:=0; (* this enables multiple broadcasts *) 

transptr:= base + tpbase; (* this does it*) 
wai tbroadcast; 
end; (* DISTRIBUTE *) 
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begin (* ICT1 *) 

expndr: -getvote(expected); (# get this iterations ndr flag *) 

if getvote(lock)-0 then (* send output and ndr-first time trash *) 
begin 

comuni 553a(obas1 553a .onunl 553a p saO, tral 553a ,rt1 ) ; 

dataf ile[sba3l 553a]: -expndr; 

comuni 553a(sbas1553a, 1 ,sa1 , tral 553a, rtl ) ; 

end; 

oldexpected: -expndr; (* save in case not ready for next iteration *) 

if expndr < 0 then expndr 1 <* compute next ndr flag *) 

else if expndr - 32767 then expndr: -1 
else expndr: -expndr+1 ; 

getnewdata; (* if ndr get real data else random data *) 

distribute; (* broadcast to other computers *) 

stobroadca3t(expected, expndr); (* save for next time *) 

ictl :*0; 
end; (* ICT1 *) 
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(*««*****»» XCT2 «****•»»*») 

GLOBAL FUNCTION ICT2: INTEGER; 

(* four processors run ict2. They take the Input values 
from ictl and rebroadcast them *) 

var more: boolean; 
iclv: bitmap; 
vpx,p,ic1p: processor; 

(**#*#***#* REBROADCAST **********) 

PROCEDURE REBROADCAST ( VPX,P: PROCESSOR); 

(* vpx * 0,1,2 corresponds to 1553 buffers a,b,c. p identifies the 
processor and therefore which mailbox *) 


var 

b,bend: buffer; 
tp,k: df index; 


begin (» broadcast what was received from others ») 


k: »dbad[p] ; 

b: -aalpha+(num1 553a*vpx); 
bend: -b+numl 553a- 1 ; 


(* datafile offset of p's mailbox *) 
(* offset within mailbox *) 

(* end of area a,b, or c *) 


while b<=bend do 
begin 

tp:=b+tpbase; (* datafile offset of my output area *■) 

datafile[tp]:-datafile[k+b]; (* move data *) 

transf ile[2*tp-1023]:-b»8; (* set transaction file *) 

b: =b+1 

end; 


waitbroadcast; 

transf ile[2*tp-1023]:-eof bit bor (bend*8); (* last buffer gets eof ») 
pideof:=0; (* this enables multiple broadcasts *) 

transptr:- tp-numl 553a + 1 ; (* this does it *) 

end; (* REBROADCAST ») 
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begin (#ICT2 *) 

(* we need to establish which processors ran ictl *) 

(* vpx keeps track of which 1553 buffers we're dealing with: a,b, or c *) 
vpx:»0; 

(* iclv is the virtual processor vector for ictl *) 

iclv bt[numworking,ic1id]; 

(* iclp is the virtual processor number *) 

iclp 1; 

repeat 

if odd(iclv) then (* then vproc iclp produced TASK ictl *) 

if vpx < 3 then (» we always have at least 3 ictl tasks *) 

begin 

p:-vtor[ic1p]; (* p now physical proc *) 

if p <> pid (# dont broadcast my ictl data ») 

then rebroadcast(vpx.p); 
vpx : - vpx + 1 ; 
end; (* if odd *); 

iclp iclp +1; (* query next virtual processor *) 

iclv := iclv div 2; 
until (iclp > numworking); 

ict2:-0; 

end; (* ICT2 *) 


Page 33 


27 - JUN-85 The SIFT Hardware/Software Systems - Volume II 

Software Listings 


(**»»*****# ICT3 **«»**»»#*) 


GLOBAL FUNCTION ICT3: INTEGER; 

(* get values replicated by ict2 and vote them *) 

var db: integer; (* db-0,1,2 corresponds to 1553 buffers a,b,c ») 

iclv: bitmap; (* bitmap of processors producing ictl *) 

iclp: processor; (* virtual processor number *) 
rep: replicate; 

(»*«*****»* GETIC2PR0C «*******»#) 

PROCEDURE GETIC2PR0C(IC1P: PROCESSOR); 

(# get set of processors that rebroadcast iclp's data, set is returned 
in global array vp *) 

var 

rep: replicate; (* will get at most 3 replicates *) 

ic2v: bitmap; (* bitmap of processors that produced ict2 «) 

ic2p: processor; (* virtual processor number *) 

begin 

rep:«1; (# begin with first replicate *) 

ic2p:»1; (* assume it was produoed by virtual processor 1 *) 

ic2v :■ bt[numworking,ic2id]; (# get bitmap *) 

while rep<-3 do (* look for at most 3 replicates *) 
begin 

while not odd(ic2v) do (* if odd ic2p produced ict2 *) 

begin (* if not odd get next #) 

ic2v :» ic2v div 2; 
ic2p :- ic2p + 1; 
end; 


(* ic2p would not rebroadcast data it produced with ictl. if numworking 
- 3 use the data originally produced by ic2p with ictl , it will be 
in correct area. If numworking < 3 will use first processor's data *) 

if (ic2p <> iclp) or (numworking-3) then 
begin 

vp[rep] :- ic2p; (* save processor number *) 

rep:«rep+1 (« look for next replicate #) 

end; (* if ic2p *) 

ic2p :- ic2p + 1; 
ic2v :» ic2v div 2; 

end; (* while rep *) 

end; (* GETIC2PR0C *) 
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(#«»«#*#*** VOTEDATA »*»*****»*) 

PROCEDURE VOTEDATA(DB: INTEGER); 

(* vote the data replicates for processors specified by array vp and 
variable db. db - 0,1,2 corresspends to 1553 buffers a,b,c *) 

var 

b,base,nb: buffer; 
v1,v2,v3: integer; 

begin 

base: -aalpha+(num1 553a* db); (* begining of buffer area *) 
for b:=0 to (num1553a-1) do 

begin (* vote each data and put in posvote array *) 

nb:«base+b; (* nb buffer number *) 

(* this next statement retrieves the replicate data from the data file, the 
statement was originally broken down into a series of statments. this 
required two more local variables, the compiler couldn’t handle this, 
using a function worked, but took too long. ») 


vl :=■ datafileC dbad[ vtor[vp[1]]] + nb ]; 

A AAA A 

II* I 

the first replicate 


the virtual number of the processor that produced it 


now a physical processor number 


start of the processor's mailbox area 


the total datafile index 


the data value *) 


v2 := datafileC dbadC vtor[vp[2]]] + nb ]; (* second rep. *) 
v3 := datafileC dbad[ vtorCvpC3]]] + nb ]; (* third rep. #) 
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if v1-v2 -then postvote [nb ] r - v 1 (» the vote *) 

else 

if v1»v3 then postvoteEnb ] : -v 1 
else 

if v2«*v3 then poffltvote[nbl :-v2 
else 

pause( 16#00C3) ; (* what *e have here is a **) 

C* failure to communicate *) 

end; (* for b *) 
end; (* VOTEDATA *) 

( JMHHM H U HNMt RESTORE **********) 


PROCEDURE RESTORE; 

(* if ndr and locked then restore temporary storage and unlock, else look 
outputs *) 

var i: integer; 


begin 

if getvote(ndr) > 0 then 
begin 

if getvote(lock) >0 then 


(*» if new data is available, and *) 
(» or else 1 *) 

C* we have been locked, then ») 

{* unlock, and *.) 

<* restore temporary *) 


begin 

stobr oadeas t ( lock , 0 ) ; 
for 1 xm o to (appnum-1 ) do 

postvote£oiMjn+ i] s-tempvote[i] ; 
end 


end 

else {* if data not aval able, and *) 

if get vote (lock) - 0 then (* we are unlocked, then *) 
begin 

stobr oadeas t (lock, 1 ) ; (* lock outputs, and *) 

for 1 0 to (appnum-1) do (* save data *) 

tempvote[i] postvote[om»B+i] ; 

end; 

end; (* RESTORE «) 


begin (* ICT3 *) 

iclv bt[numworking,ic1id]; 
iclp 1; 

for db:-0 to 2 do 
begin 

if numworking >» 3 then 
begin 

while not odd(iclv) do 
begin 

iclv ;» iclv div 2; 
iclp iclp ♦ 1 ; 
end; 

getic2proc(ic1p); 

end 


(* get task vector for lot) •) 
(» virtual processor 1 *) 

(* for 1553 buffers a,b,e do ’») 


(* get set of processors which *) 

(* produced replicates of area db *) 

(* this corresponds to the prooessors *) 
(* which rebroadcast Ictl's data *) 


(* processor set returned in array vp *) 
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else (* else use processor 1 *) 

for rep:-1 to 3 do vp[rep]:-1; 


votedata(db); 

(* vote the replicates, putting results 
in postvote array *) 

iclp 
icl v 

iclp + 1 ; 
iclv div 2; 

(* get next ictl task *) 

end; 

(* for db *) 


restore; 


(# if we have new data, restore temporary 
data storage *) 

ict3s “0; 




end; (* ICT3 *) 


(#***###*** median ********»*) 

GLOBAL FUNCTION MEDIAN (Q: BUFFER ): INTEGER; 

(* Find the median of the a, b, and c values and set postvote 
buffer q and return the value. *) 


var 

res.t.vl ,v2,v3: integer; 
begin 

vl :=postvote[q]; 

if numworking<3 then res:-v1 (* default case. *) 
else 
begin 

v2:=postvote[q+num1553a] ; 

if v1-v2 then res:-v1 (* in this game a pair wins *) 

else 

begin (# no pair, then put them in order *) 

v3:-postvote[q+2*num1 553®]; 


if v1>v2 then 
begin t:»v1 ; 


(* make vl < v2 *) 
v1:-v2; v2:-t end; 


if v1>v3 then 
begin t:-v1 ; 


C* and vl < v3 *) 
v1:-v3; v3:-t end; 


if v2>v3 then 
begin t:«v2; 


(* and v2 < v3 *) 
v2:-v3; v3:-t end; 


res:-v2 

end 

end; 


dataf ile[tpbase+q]:-res; postvote[q]:-res; median: -res 
end; (* MEDIAN *) 
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(*«***«»*»» xciNlT **********) 


globed procedure icinit; 

var i: integer; 

begia 

postvote[expected]:»0; (* we start with 0 as expected flag *) 

stobroadcast ( expected , 0 ) ; 

postvote[lock] 0; (* outputs unlocked *) 

stobroadcast ( lock , 0 ) ; 

for i:» 0 to (appnum-1) do (* clear temporary area *) 
begin 

tempvoteCi] :* 0; 

postvote[onum+i] s -0; 
end; 

postvote[olatmo] :-1 ; (* or else these guys dont broadcast, oy») 

postvote[opitmo] :-1 ; 

end; (* ICINIT, IC *) . 
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MODULE SIFTIH.SR 


NAME ASSEM 

* 

TITLE SIFT: Interrupt handler 

* 

* The Interrupt handler for the SIFT operating system handles clock 

* interrupts, task termination, and system startup. 

* 

* There are also routines to initialize and reinitialize state vectors. 

* These routines save the state of the currently running task, and then 

* transfer control to the (pascal) scheduler who will start up 

* a new task after restoring its state. 

* 

* Saving the state: The following is saved in order: 

* 1. RO 

* 2. Flags 

* 3. R1-R13 

* 4 . PC 

* RIM should not be saved as it is the heap pointer. NEW should 

* be noninterruptible for this reason, but since SIFT doesn't use 

* NEW it isn't a problem. At this point we change over to the 

* "exec" stack which will be initialized with the function code 

* ( termination, clocktick, startup) and the top of the task stack 

* which needs to be saved in the task table for the currently 

* running process. The index of the currently running process 

* is in the global variable TSKID. 

* 

* 



ABS 



ORG 

100H 


CONT 

ER, IS 


JU* 

ASIFT 

ASIFT 

LINK 

SIFT 

* 


ORG 

HALT 

40 OH 

* 


JMAO* 

ACINT 

# 


Starting location 

Disable interrupts for initialization 
Go execute. 


Address of real time clock interrupt 
Halt on powerfail 

Go to the realtime routine. 


ACINT is location 40H and set up by a DEFPZ 
instruction to point to label CINT. The DEFPZ 



is invoked after CINT 

to avoid an error. 

RET 

0 

INTERRUPT 

2 

RET 

0 

INTERRUPT 

3 

RET 

0 

ONTERRUPT 

4 
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ORG 

3400H 

The 

transaction file 

BSZ 

1024 



ORG 

7400H 

The 

datafile 

BSZ 

1016 




* Code to start up the scheduler initially. 

* This code is much like the TTERM and CINT, but it is called directly 

* fran pascal (it is not a return from a task termination, or clock int). 
» 


* 

REL 




EXTRN 

IN IT I 

Initializing routine in SIFTOP 

AIN IT 

LINK 

INITI 


STACK 

£ 

FIX 

5000H 


SIFT 

LOAD 

0, STACK 

Pick up the stack address 


TRA 

15,0 

Put it in the stack pointer 


CLAO 

1,1 



CLAO 

2,2 



CLAO 

3,3 



CLAO 

4,4 



CLAO 

5,5 



CLAO 

6,6 



CLAO 

7,7 



CLAO 

8,8 



CLAO 

9,9 



CLAO 

10,10 



CLAO 

11,11 



CLAO 

12,12 



CLAO 

13,13 



CLAO 

14,14 



JSS* 

AIN IT 

Intialize the OS 


CONT 

ES 

Allow Interrupts 

STLP 

£ 

JU 

STLP 

And wait for one to happen. 


ENTRY 

DISAB 

Routine called frcm Pascal to 

DISAB 

CONT 

ER 

disable interrupts. 

£ 

RPS 

0 



ENTRY 

ENABL 

Routine called frcm Pascal to 

ENABL 

CONT 

ES 

enable interrupts. 

£ 

RPS 

0 


RPCNT 

£ 

LINK 

381 OH 

Subframe repeat counter. Set in Tschedule 

ACLK 

FIX 

1 

Clock tick function code 

ASTRT 

FIX 

2 

System startup function code 

AEND 

FIX 

17 

Constant, that when added to the the base of 


a statevector, points you at the end of it. 
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* 

* Code to handle task termination. This basically means setting 

* things up for next time and then calling the scheduler to 

* process task termination. This should run disabled 

* 



ENTRY 

TTERM 


ATERM 

* 

LINK 

TTERM 


TTERM 

CONT 

ER 

disallow interrupts 


LOAD 

0, ATERM 

on task termination return here 


PUSHM 

0,0 



PUSHM 

0,0 

dummy rO save 


TRA 

0,15 

point at top of stack 


LOAD 

0,~2,0 

get start PC in 0 


PUSHF 

15 

save flags 


PUSHM 

M3 

save registers 


PUSHM 

0,0 

save resume PC (which is the start) 


CLAO 

0,0 

indicate a task termination 


JU 

SCHG 

to the scheduler 


* 

* Here is the main clock interrupt handler. By the time it 

* gets called, RO has been saved on the stack and now contains 

* the resume address. Increment repeat counter and goto 

* scheduler if necessary (i.e. * 0) . 

* 



EXTRN 

SCHED 


ASCHE 

* 

LINK 

SCHED 

link to scheduler 

CINT 

PUSHF 

15 

save the flags 


PUSHM 

M 

Save a work register 


LOAD* 

1 ,RPCNT 

Get repeat counter 


IAR 

M 

inc the counter 


SKNE 

1 , NOINT 

if <> 0 restore 

* 

JU 

DOINT 

else call scheduler 

NOINT 

STO* 

1 ,RPCNT 

save for next time 


P0PM 

M 

Restore the register 


POPF 

15 

and the flags 


CONT 

ES 

Allow interrupts 

* 

RET 

0 

And return 

DOINT 

PUSHM 

2,13 

Save registers (14 is heap no need to save) 


PUSHM 

0,0 

and the resume address 


LOAD 

0, ACLK 

indicate clock interrupt 

SCHG 

TRA 

1,15 

save the current stack pointer 


LDM 

15, 15, STACK 

point at the executive stack 


PUSHM 

0,1 

set function code and resume stack 


JSS* 

ASCHE 

call the scheduler which is a pascal function 

* 



which returns the new task’s stack pointer 


TRA 

15,12 

this puts it in its place 


POPM 

0,0 

restore the resume PC to R0 


POPM 

M3 

restore some registers. 


POPF 

15 

and the flags 


CONT 

ES 

allow interrupts 

* 

RET 

0 

and go resume this routine 


DEFPZ 

4 OH, CINT, ACINT Map ACINT to CINT thru location 40H 
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* 

* Code to reinitialize a state vector 

* The initial stack should look like: 

* 1 . Starting address of the routine (preset in task schedule) 

* 2. Address of TTERM 

* 3. 15 words of nothing (rO, flags ,r1-r1 3) 

* 4. Starting address of the routine 

* 

* REINI is a procedure called as: 

* 

* procedure reinit(var stack: integer; var state: statevect or); 

* Upon exit it should set stack to point at the 4th item above. 

* 


ENTRY 

* 

REINI 


REINI PUSHM 

0,2 


TRA 

0,15 


LOAD 

1 ,“4,0 

starting address of statevector 

LOAD 

2,0,1 

get starting address of routine 

STO 

2,17,1 

set up vector 

LOAD 

2.ATERM 

start of tterm 

STO 

2,1,1 

save it away 

ADD 

1 ,AEND 

point at end of statevector 

STO* 

1 ,"5,0 

return the top of stack address 

POPM 

0,2 

restore registers 

RPS 

0 

return 


* 

* 


* 

PAGE 



£ 

TITLE 

SIFT: Halt 

(debugging) routine 

* 

£ 

procedure pause (err code: integer ); 


ENTRY 

PAUSE 


PAUSE 

PUSHM 

0,1 



TRA 

0,15 



C0NT 

ER 

disable interrupts 


LOAD 

1 ,"3,0 



HALT 




CONT 

ES 

enable interrupts 


POPM 

0,1 



RPS 

0 



* 

* 
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TITLE SIFT: Delay routine 
procedure wait(X: integer); 


# 


* 

wait for approximately X 

* 

ENTRY 

WAIT 

WAIT 

PUSHM 

0,3 


TRA 

0,15 


LOAD 

2, -5,0 


LOAD 

1 ,F1 0 


MPY 

2,1 


SRLA 

2,1 

OUTER 

LOAD 

1 , HFFFF 

INNER 

DECNE 

1 .INNER 


DECNE 

3, OUTER 


POPM 

0,3 


RPS 

0 

HFFFF 

FIX 

OFFFFH 

FI 0 

FIX 

10 


* 

* 


seconds before returning. 


; SAVE SOME REGISTERS 
; POINT AT THE DISPLAY 
; GET THE NUMBER OF SECONDS 
; ADJUST FOR TIMING 
; MULTIPLY IT OUT 
; RESULT IN 3 

; INNER LOOP TAKES ABOUT .1 SECOND 
; OUTER LOOP TAKES ABOUT X SECONDS 


* function to return global clock value 

* 

* 


GCLOC 


TITLE 

GCLOCK 

ENTRY 

GCLOC 

PUSHM 

0,1 

ID 

0,8 

TRA 

12,0 

POPM 

0,1 

RPS 

0 

END 
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MODULE SCHEDULE. SR 


NAME TASKT 

TITLE SIFT: Equates 

DATE 

ABS 

* 

* 

* 

* with new improved schedule counters 

* 

* 


SLOC 

EQU 

6 DO OH 

TLOC 

EQU 

5 50 OH 

ILOC 

EQU 

7800H 

* 



* Buffer 

names 

# 



CMDAI 

EQU 

103 

CMDEL 

EQU 

104 

CMDRN 

EQU 

105 

CMDTH 

EQU 

106 

ERRER 

EQU 

33 

EXPEX 

EQU 

36 

GEMEM 

EQU 

35 

GEREC 

EQU 

34 

LOCK 

EQU 

37 

NDR 

EQU 

38 

PHIN 

EQU 

113 

PSIN 

EQU 

114 

QDELY 

EQU 

107 

QDELZ 

EQU 

108 

QLATM 

EQU 

110 

QPITM 

EQU 

109 

QX 

EQU 

116 

QY 

EQU 

117 

QZ 

EQU 

118 

RN 

EQU 

115 

TIMER 

EQU 

119 

XRESE 

EQU 

39 
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* 



TITLE 

SIFT: Task Table 

# 

* 

* 


EXTRN 

TTERM 

# 


ORG 

TLOC 

TASK 

MACRO 

2 


EXTRN 

*0 


FIX 

0 


FIX 

*1 


FIX 

0 


LINK 

*+18 


LINK 

%o 


LINK 

TTERM 


BSZ 

15 


LINK 

$0 


BSZ 

ENDM 

111 

* 

ZTASK 

MACRO 

1 


BSZ 

ENDM 

133 

# 

TO 

ZTASK 

0 

T1 

TASK 

NULLT.BUF1 

T2 

TASK 

CLKTA,BUF2 

T3 

TASK 

ICT1 ,BUF3 

T4 

TASK 

ICT2.BUF4 

T5 

TASK 

ICT3.BUF5 

T6 

TASK 

ERRTA.BUF6 

T7 

TASK 

FAULT, BUF7 

T8 

TASK 

RECFT.BUF8 

T9 

TASK 

MLS.BUF9 

T10 

TASK 

GUI DA , BUF 1 0 

Til 

TASK 

PITCH, BUF11 

T12 

TASK 

LATER, BUF 12 


* 


PAGE 

TITLE SIFT: Buffer Information Table 

# 

* 

# 


ORG ILOC 

EVENT MACRO 1 

FIX %0 EVENT INDICATION 

ENDM 
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* 


STLOC 

EQU 

* 


# 




* 



CLKTA 

BUF2 

EQU 

* -STLOC 



FIX 

0 


# 



ERRTA 

BUF6 

EQU 

* -STLOC 



FIX 

0 


* 



FAULT 

BUF7 

EQU 

* -STLOC 



EVENT 

GEREC 



EVENT 

GEMEM 



FIX 

0 


* 



GUI DA 

BUF10 

EQU 

*~STLOC 



EVENT 

PSIN 



EVENT 

PHIN 



EVENT 

RN 



EVENT 

QDELY 



EVENT 

QLATM 



EVENT 

TIMER 



FIX 

0 


* 



ICT1 

BUF3 

EQU 

* -STLOC 



EVENT 

EXP EX 



EVENT 

XRESE 



EVENT 

NDR 



FIX 

0 


* 



ICT2 

BUF4 

EQU 

* -STLOC 



FIX 

0 


* 



ICT3 

BUF5 

EQU 

*-STLOC 



EVENT 

LOCK 



FIX 

0 


# 



LATER 

BUF12 

EQU 

*-STLOC 



EVENT 

CMDAI 



EVENT 

CMDRN 



FIX 

0 


* 



MLS 

BUF9 

EQU 

* -STLOC 



EVENT 

QX 



EVENT 

QZ 



EVENT 

QY 



FIX 

0 


* 



NULLT 

BUF1 

EQU 

* -STLOC 



FIX 

0 
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# 



PITCH 

BUF1 1 

EQU 

*-STLOC 


EVENT 

CMDEL 



EVENT 

QDELZ 



EVENT 

CMDTH 



EVENT 

QPITM 



FIX 

0 


* 



RECFT 

BUF8 

EQU 

*-STLOC 



FIX 

0 



PAGE 




TITLE 

SIFT: Schedule Table 

* 




* 




* 





ORG 

SLOC 


SFLEN 

MACRO 

1 



FIX 

%o 

NUMBER OF 1 .6 MSEC TICKS /SUBFRAME 


ENDM 



* 




SFEND 

MACRO 

0 



FIX 

0 

END OF VOTE FRAME 


ENDM 



* 




SCHED 

MACRO 

4 



FIX 

*0 

NUMBER OF PROCESSORS 


FIX 

*1 

WHICH ONE 


FIX 

1+Z3-J2 



ENDM 



# 




SEND 

MACRO 

0 



FIX 

-1 

END OF SCHEDULE 


ENDM 



* 




VCSCD 

EQU 

99 


* 




S1 1 

SCHED 

1 ,1,311, 

,E1 1 


EVENT 

2 

CLKTA 


SFLEN 

2 



EVENT 

3 

ICT1 


SFLEN 

3 



EVENT 

4 

ICT2 


SFLEN 

2 



EVENT 

5 

ICT3 


SFLEN 

5 



EVENT 

9 

MLS 


SFLEN 

2 



EVENT 

10 

GUI DA 


SFLEN 

2 



EVENT 

11 

PITCH 


SFLEN 

2 



EVENT 

12 

LATER 


SFLEN 

2 



EVENT 

6 

ERRTA 


SFLEN 

2 
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EVENT 

1 

NULLT 

SFLEN 

2 


EVENT 

3 

ICT1 

SFLEN 

3 


EVENT 

4 

ICT2 

SFLEN 

2 


EVENT 

5 

ICT3 

SFLEN 

5 


EVENT 

9 

MLS 

SFLEN 

2 


EVENT 

10 

GUI DA 

SFLEN 

2 


EVENT 

11 

PITCH 

SFLEN 

2 


EVENT 

12 

LATER 

SFLEN 

2 


EVENT 

7 

FAULT 

SFLEN 

3 


EVENT 

1 

NULLT 

SFLEN 

2 


EVENT 

3 

ICT1 

SFLEN 

3 


EVENT 

4 

ICT2 

SFLEN 

2 


EVENT 

5 

ICT3 

SFLEN 

5 


EVENT 

9 

MLS 

SFLEN 

2 


EVENT 

10 

GUI DA 

SFLEN 

2 


EVENT 

11 

PITCH 

SFLEN 

2 


EVENT 

12 

LATER 

SFLEN 

2 


EVENT 

8 

RECFT 

SFLEN 

SEND 

2 


SCHED 

1 ,VCSCD 

,S199,1 

SFEND 


0 

SFEND 


1 

EVENT 

3 

ICT1 

SFEND 


2 

SFEND 


3 

EVENT 

5 

ICT3 

SFEND 


4 

EVENT 

9 

MLS 

SFEND 


5 

EVENT 

10 

GUI DA 

SFEND 


6 

EVENT 

11 

PITCH 

SFEND 


7 

EVENT 

12 

LATER 

SFEND 


8 

EVENT 

6 

ERRTA 
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SFEND 


9 

SFEND 


10 

EVENT 

3 

icti 

SFEND 


1 1 

SFEND 


1 2 

EVENT 

5 

ICT3 

SFEND 


13 

EVENT 

9 

MLS 

SFEND 


14 

EVENT 

10 

GUI DA 

SFEND 


15 

EVENT 

11 

PITCH 

SFEND 


16 

EVENT 

12 

LATER 

SFEND 


17 

EVENT 

7 

FAULT 

SFEND 


18 

SFEND 


19 

EVENT 

3 

ICTI 

SFEND 


20 

SFEND 


21 

EVENT 

5 

ICT3 

SFEND 


22 

EVENT 

9 

MLS 

SFEND 


23 

EVENT 

10 

GUI DA 

SFEND 


24 

EVENT 

1 1 

PITCH 

SFEND 


25 

EVENT . 

12 

LATER 

SFEND 


26 

SFEND 

SFEND 


27 

EVENT 

SEND 

-1 
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In the interest of efficiency, the remaining schedules are represented 
symbolically by the following. 


SIFT SCHEDULES FOR 2 PROCESSOR 


SLOT TICK S21 S22 TASK : VARIABLES VOTED 


1 

0 

CLKTA 

CLKTA 






2 

2 

ICT1 

ICT1 






3 

5 

ICT2 

ICT2 

ICT1 : 

EXP EX 

XRESE 

NDR 


4 

7 

ICT3 

ICT3 






5 

12 

MLS 

NULLT 

ICT3 : 

LOCK 




6 

14 

NULLT 

GUI DA 

MLS : 

QX 

QZ 

QY 


7 

16 

PITCH 

NULLT 

GUI DA: 

PSIN 

PHIN 

RN 

QDELY QLATM TIMER 

8 

18 

NULLT 

LATER 

PITCH : 

CMDEL 

QDELZ 

CMDTH 

QPITM 

9 

20 

ERRTA 

ERRTA 

LATER : 

CMDAI 

CMDRN 



10 

22 

NULLT 

NULLT 

ERRTA : 





1 1 

24 

ICT1 

ICT1 






12 

27 

ICT2 

ICT2 

ICT1 : 

EXP EX 

XRESE 

NDR 


13 

29 

ICT3 

ICT3 






14 

34 

MLS 

NULLT 

ICT3 : 

LOCK 




15 

36 

NULLT 

GUI DA 

MLS : 

QX 

QZ 

QY 


16 

38 

PITCH 

NULLT 

GUI DA: 

PSIN 

PHIN 

RN 

QDELY QLATM TIMER 

17 

40 

NULLT 

LATER 

PITCH : 

CMDEL 

QDELZ 

CMDTH 

QPITM 

18 

42 

FAULT 

NULLT 

LATER : 

CMDAI 

CMDRN 



19 

45 

NULLT 

NULLT 

FAULT: 

GEREC 

GEMEM 



20 

47 

ICT1 

ICT1 






21 

50 

ICT2 

ICT2 

ICT1 : 

EXP EX 

XRESE 

NDR 


22 

52 

ICT3 

ICT3 






23 

57 

MLS 

NULLT 

ICT3 : 

LOCK 




24 

59 

NULLT 

GUI DA 

MLS : 

QX 

QZ 

QY 


25 

61 

PITCH 

NULLT 

GUI DA: 

PSIN 

PHIN 

RN 

QDELY QLATM TIMER 

26 

63 

NULLT 

LATER 

PITCH: 

CMDEL 

QDELZ 

CMDTH 

QPITM 

27 

65 

RECFT 

RECFT 

LATER : 

CMDAI 

CMDRN 
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SIFT SCHEDULES FOR 3 PROCESSORS 


SLOT 

TICK 

S31 

S3 2 

S3 3 

TASK : VARIABLES VOTED 



i 

0 

CLKTA 

CLKTA 

CLKTA 







2 

2 

ICT1 

ICT1 

ICT1 







3 

5 

ICT2 

ICT2 

ICT2 

ICT1 : 

EXPEX 

XRESE 

NDR 



4 

7 

ICT3 

ICT3 

ICT3 







5 

12 

MLS 

MLS 

MLS 

ICT3 s 

LOCK 





6 

14 

GUI DA 

GUI DA 

GUI DA 

MLS : 

QX 

QZ 

QY 



7 

16 

PITCH 

PITCH 

PITCH 

GUI DA: 

PSIN 

PHIN 

RN 

QDELY 

QLATM TIMER 

8 

18 

LATER 

LATER 

LATER 

PITOT: 

CMDEL 

QDELZ 

CMDTH 

QPITM 


9 

20 

ERRTA 

ERRTA 

ERRTA 

LATER : 

CMDAI 

CMDRN 




10 

22 

NULLT 

NULLT 

NULLT 

ERRTA: 






1 1 

24 

ICT1 

ICT1 

ICT1 







12 

27 

ICT2 

ICT2 

ICT2 

ICT1 : 

EXPEX 

XRESE 

NDR 



13 

29 

ICT3 

ICT3 

ICT3 







14 

34 

MLS 

MLS 

MLS 

ICT3 : 

LOCK 





15 

36 

GUI DA 

GUI DA 

GUI DA 

MLS : 

QX 

QZ 

QY 



16 

38 

PITCH 

PITCH 

PITCH 

GUI DA: 

PSIN 

PHIN 

RN 

QDELY 

QLATM TIMER 

17 

40 

LATER 

LATER 

LATER 

PITOT: 

CMDEL 

QDELZ 

CMDTH 

QPITM 


18 

42 

FAULT 

FAULT 

FAULT 

LATER: 

CMDAI 

CMDRN 




19 

45 

NULLT 

NULLT 

NULLT 

FAULT: 

GEREC 

GEMEM 




20 

47 

ICT1 

ICT1 

ICT1 







21 

50 

ICT2 

ICT2 

ICT2 

ICT1 : 

EXPEX 

XRESE 

NDR 



22 

52 

ICT3 

ICT3 

ICT3 







23 

57 

MLS 

MLS 

MLS 

. ICT3 : 

LOCK 





24 

59 

GUI DA 

GUI DA 

GUI DA 

. MLS : 

QX 

QZ 

QY 



25 

61 

PITCH 

PITCH 

PITOT 

GUI DA: 

PSIN 

PHIN 

RN 

QDELY 

QLATM TIMER 

26 

63 

LATER 

LATER 

LATER 

PITOT: 

CMDEL 

QDELZ 

CMDTH 

QPITM 


27 

65 

RECFT 

RECFT 

RECFT 

LATER : 

CMDAI 

CMDRN 
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SIFT SCHEDULE FOR 4 PROCESSORS 


SLOT 

TICK 

S41 

S42 

S43 

S44 

TASK : VARIABLES VOTED 


1 

0 

CLKTA 

CLKTA 

CLKTA 

CLKTA 






2 

2 

ICT1 

ICT1 

ICT1 

NULLT 






3 

5 

ICT2 

ICT2 

ICT2 

ICT2 

ICT1 : 

EXP EX 

XRESE 

NDR 


4 

7 

ICT3 

ICT3 

ICT3 

ICT3 






5 

12 

MLS 

MLS 

NULLT 

MLS 

ICT3 : 

LOCK 




6 

14 

GUI DA 

NULLT 

GUI DA 

GUI DA 

MLS : 

QX 

QZ 

QY 


7 

16 

NULLT 

PITCH 

PITCH 

PITCH 

GUI DA: 

PSIN 

PHIN 

RN 









QDELY 

QLATM 

TIMER 


8 

18 

LATER 

LATER 

LATER 

NULLT 

PITCH: 

CMDEL 

QDELZ 

CMDTH 

QPITM 

9 

20 

ERRTA 

ERRTA 

ERRTA 

ERRTA 

LATER: 

CMDAI 

CMDRN 



10 

22 

NULLT 

NULLT 

NULLT 

NULLT 

ERRTA: 





11 

24 

ICT1 

ICT1 

ICT1 

NULLT 






12 

27 

ICT2 

ICT2 

ICT2 

ICT2 

ICT1 : 

EXPEX 

XRESE 

NDR 


13 

29 

ICT3 

ICT3 

ICT3 

ICT3 






14 

34 

MLS 

MLS 

NULLT 

MLS 

ICT3 : 

LOCK 




15 

36 

GUI DA 

NULLT 

GUI DA 

GUI DA 

MLS : 

QX 

QZ 

QY 


16 

38 

NULLT 

PITCH 

PITCH 

PITCH 

GUI DA: 

PSIN 

PHIN 

RN 









QDELY 

QLATM 

TIMER 


17 

40 

LATER 

LATER 

LATER 

NULLT 

PITCH: 

CMDEL 

QDELZ 

CMDTH 

QPITM 

18 

42 

FAULT 

FAULT 

NULLT 

FAULT 

LATER: 

CMDAI 

CMDRN 



19 

45 

NULLT 

NULLT 

NULLT 

NULLT 

FAULT: 

GEREC 

GEMEM 



20 

47 

ICT1 

ICT1 

ICT1 

NULLT 






21 

50 

ICT2 

ICT2 

ICT2 

ICT2 

ICT1 : 

EXPEX 

XRESE 

NDR 


22 

52 

ICT3 

ICT3 

ICT3 

ICT3 






23 

57 

MLS 

MLS 

NULLT 

MLS 

ICT3 : 

LOCK 




24 

59 

GUI DA 

NULLT 

GUI DA 

GUI DA 

MLS : 

QX 

QZ 

QY 


25 

61 

NULLT 

PITCH 

PITCH 

PITCH 

GUI DA: 

PSIN 

PHIN 

RN 









QDELY 

QLATM 

TIMER 


26 

63 

LATER 

LATER 

LATER 

NULLT 

PITCH: 

CMDEL 

QDELZ 

CMDTH 

QPITM 

27 

65 

RECFT 

RECFT 

RECFT 

RECFT 

LATER: 

CMDAI 

CMDRN 
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SIFT SCHEDULE FOR 5 PROCESSORS 


SLOT 

TICK 

S51 

S52 

S53 

S54 

S55 

TASK : VARIABLES VOTED 


1 

0 

CLKTA 

CLKTA 

CLKTA 

CLKTA 

CLKTA 






2 

2 

ICT1 

ICT1 

ICT1 

NULLT 

NULLT 






3 

5 

ICT2 

ICT2 

NULLT 

ICT2 

ICT2 

ICT1 : 

EXP EX 

XRESE 

NDR 


4 

7 

ICT3 

ICT3 

ICT3 

ICT3 

ICT3 






5 

12 

MLS 

MLS 

MLS 

MLS 

MLS 

ICT3 : 

LOCK 




6 

14 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

MLS ; 

QX 

QZ 

QY 


7 

16 

PITCH 

PITCH 

PITCH 

PITCH 

PITCH 

GUI DA : 

PSIN 

PHIN 

RN 










QDELY 

QLATM 

TIMER 


8 

18 

LATER 

LATER 

LATER 

LATER 

LATER 

PITCH: 

CMDEL 

QDELZ 

CMDTH 

QPITM 

9 

20 

ERRTA 

ERRTA 

ERRTA 

ERRTA 

ERRTA 

LATER : 

CMDAI 

CMDRN 



10 

22 

NULLT 

NULLT 

NULLT 

NULLT 

NULLT 

ERRTA: 





11 

24 

ICT1 

ICT1 

ICT1 

NULLT 

NULLT 






12 

27 

ICT2 

ICT2 

NULLT 

ICT2 

ICT2 

ICT1 : 

EXPEX 

XRESE 

NDR 


13 

29 

ICT3 

ICT3 

ICT3 

ICT3 

ICT3 






14 

34 

MLS 

MLS 

MLS 

MLS 

MLS 

ICT3 : 

LOCK 




15 

36 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

MLS : 

QX 

QZ 

QY 


16 

38 

PITCH 

PITCH 

PITCH 

PITCH 

PITCH 

GUI DA: 

PSIN 

PHIN 

RN 










QDELY 

QLATM 

TIMER 


17 

40 

LATER 

LATER 

LATER 

LATER 

LATER 

PITCH: 

CMDEL 

QDELZ 

CMDTH 

QPITM 

18 

42 

FAULT 

FAULT 

FAULT 

FAULT 

FAULT 

LATER : 

CMDAI 

CMDRN 



19 

45 

NULLT 

NULLT 

NULLT 

NULLT 

NULLT 

FAULT: 

GEREC 

GEMEM 



20 

47 

ICT1 

ICT1 

ICT1 

NULLT 

NULLT 






21 

50 

ICT2 

ICT2 

NULLT 

ICT2 

ICT2 

ICT1 : 

EXPEX 

XRESE 

NDR 


22 

52 

ICT3 

ICT3 

ICT3 

ICT3 

ICT3 






23 

57 

MLS 

MLS 

MLS 

MLS 

MLS 

ICT3 : 

LOCK 




24 

59 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

MLS : 

QX 

QZ 

QY 


25 

61 

PITCH 

PITCH 

PITCH 

PITCH 

PITCH 

GUI DA: 

PSIN 

PHIN 

RN 










QDELY 

QLATM 

TIMER 


26 

63 

LATER 

LATER 

LATER 

LATER 

LATER 

PITCH: 

CMDEL 

QDELZ 

CMDTH 

QPITM 

27 

65 

RECFT 

RECFT 

RECFT 

RECFT 

RECFT 

LATER: 

CMDAI 

CMDRN 
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SIFT SCHEDULE FOR 6 PROCESSORS 


SLOT 

TICK 

S61 

S62 

S63 

S64 

S65 

S66 

TASK : 

VARIABLES VOTED 

1 

0 

CLKTA 

CLICTA 

CLKTA 

CLICTA 

CLKTA 

CLKTA 





2 

2 

ICT1 

ICT1 

ICT1 

NULLT 

NULLT 

NULLT 





3 

5 

ICT2 

NULLT 

NULLT 

ICT2 

ICT2 

ICT2 

ICT1 : 

EXP EX 

XRESE 

NDR 

4 

7 

ICT3 

ICT3 

ICT3 

ICT3 

ICT3 

ICT3 





5 

12 

NULLT 

MLS 

MLS 

MLS 

MLS 

MLS 

ICT3 : 

LOCK 



6 

14 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

NULLT 

MLS : 

QX 

QZ 

QX 

7 

16 

PITCH 

PITCH 

PITCH 

PITCH 

NULLT 

PITCH 

GUI DA: 

PSIN 

PHIN 

RN 










QDELY 

QLATM 

TIMER 

8 

18 

LATER 

LATER 

LATER 

NULLT 

LATER 

LATER 

PITCH: 

CMDEL 

QDELZ 

CMDTH 










QPITM 



9 

20 

ERRTA 

ERRTA 

ERRTA 

ERRTA 

ERRTA 

ERRTA 

LATER : 

CMDAI 

CMDRN 


10 

22 

NULLT 

NULLT 

NULLT 

NULLT 

NULLT 

NULLT 

ERRTA: 




1 1 

24 

ICT1 

ICT1 

ICT1 

NULLT 

NULLT 

NULLT 





12 

27 

ICT2 

NULLT 

NULLT 

ICT2 

ICT2 

ICT2 

ICT1 : 

EXPEX 

XRESE 

NDR 

13 

29 

ICT3 

ICT3 

ICT3 

ICT3 

ICT3 

ICT3 





1 4 

34 

NULLT 

MLS 

MLS 

MLS 

MLS 

MLS 

ICT3 : 

LOCK 



15 

36 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

NULLT 

MLS : 

QX 

QZ 

QX 

16 

38 

PITCH 

PITCH 

PITCH 

PITCH 

NULLT 

PITCH 

GUI DA: 

PSIN 

PHIN 

RN 










QDELY 

QLATM 

TIMER 

17 

40 

LATER 

LATER 

LATER 

NULLT 

LATER 

LATER 

PITCH: 

CMDEL 

QDELZ 

CMDTH 










QPITM 



18 

42 

FAULT 

FAULT 

NULLT 

FAULT 

FAULT 

FAULT 

LATER: 

CMDAI 

CMDRN 


19 

45 

NULLT 

NULLT 

NULLT 

NULLT 

NULLT 

NULLT 

FAULT: 

GEREC 

GEMEM 


20 

47 

ICT1 

ICT1 

ICT1 

NULLT 

NULLT 

NULLT 





21 

50 

ICT2 

NULLT 

NULLT 

ICT2 

ICT2 

ICT2 

ICT1 : 

EXPEX 

XRESE 

NDR 

22 

52 

ICT3 

ICT3 

ICT3 

ICT3 

ICT3 

ICT3 





23 

57 

NULLT 

MLS 

MLS 

MLS 

MLS 

MLS 

ICT3 : 

LOCK 



24 

59 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

GUI DA 

NULLT 

MLS : 

QX 

QZ 

QX 

25 

61 

PITCH 

PITCH 

PITCH 

PITCH 

NULLT 

PITCH 

GUI DA: 

PSIN 

PHIN 

RN 










QDELY 

QLATM 

TIMER 

26 

63 

LATER 

LATER 

LATER 

NULLT 

LATER 

LATER 

PITCH: 

CMDEL 

QDELZ 

CMDTH 










QPITM 



27 

65 

RECFT 

RECFT 

RECFT 

RECFT 

RECFT 

RECFT 

LATER: 

CMDAI 

CMDRN 



* 


END 
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MODULE GLOBALS.SR 


NAME GLOBALS 
ABS 

* 

* HERE WE FIX THE LOCATIONS OF THE GLOBAL SYMBOLS. THE ONLY NEED FOR THIS IS 

* TO GIVE THESE LOCATIONS PROPER SYMBOL NAMES, WHICH PASCAL* DOES NOT 

* 

* 

* NOTE SIFTDEC.GLO SUPPLIES THE GLOBAL SYMBOLS TO PASCAL MODULES. FILE 

* GLOBALS.SR SUPPLIES THE LINKER WITH SYMBOL NAMES FOR THESE LOCATIONS. 

* BOTH FILES SHOULD BE MAINTAINED 

* 


* const 

* tfloc-1 603400; 

TRANF EQU 3400H 

* gfrlc=1 6#3 800 ; 

GFRAM EQU 3800H 

* sfclc-1 603801 ; 

SFCOU EQU 3801H 

* dbloc-1 603802; 

DBAD EQU 3802H 

* rploc-1 60381 0; 

RPCNT EQU 381 OH 

* stackloc=1 605000; 

STACK EQU 5000H 

* TLOC-1 605500; 

TT EQU 5 50 OH 

* bloc-1606000; 

BT EQU 600 OH 

* numloc=1 606800; 

NUMWO EQU 6 80 OH 

* pidloc-1 606801 5 

PID EQU 6801H 

* vtorloc=1 606802; 

VTOR EQU 6802H 

* rtovloc=1 6068OA; 

RTOV EQU 6 80 AH 

* pvloc-1 606840; 

POSTV EQU 6840H 

* • Sloc-1606DOO; 

SCHED EQU 6 DO OH 

* dfloc-1 607400; 

DATAF EQU 7 40 OH 

* pfloc=1 6077F8; 

PFLOC EQU 77F8H 

* tploc-1 6077F9; 

TRANP EQU 77F9H 

* s151oc»1 6077F9; 

STA1 5 EQU 77F9H 

* clkloc-1 6077FB; 


(* Address of transaction file. *) 

(* Address of global frame count *) 

(* Address of subframe count *) 

(* Address of dbad. *) 

(* Address of rpent *) 

(* "Exec Stack" location - siftih *) 
(* Address of tt. *) 

(* Address of bt. *) 

(* Address of numworking. *) 

(* Address of pid. *) 

(* Address of vtor. *) 

(* Address of rtov. *) 

(* Address of post vote buffer. *) 

(* Address of scheds. *) 

(* Address of datafile. *) 

(* Address of pideof. *) 

(* Address of trans pointer. *) 

(* Address of sta1553a. *) 

(* Address of read time clock. *) 
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CLOCK EQU 77FBH 

* cl 51oc-1 6#77FD; 

CMD1 5 EQU 77FDH 

* a151oc=l6#77FF; 

ADR1 5 EQU 77FFH 

* iloc=l6#7800; 

EQU 7800H 


(* Address of cmd1553a* *) 

(* Address of adr1553a. «) 

(* Address of buffer info. *) 


BINF 
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MODULE SIFTAP.MCP 

PROGRAM SIFTAP; 

include * siftdec.con’ ; 
include 'siftdec.typ’ ; 

var 

s : integer; (* to relieve compiler bugs , thanx chuck *) 
v:array[1 . .25] of integer; (* trig values. #) 

(* The following are locals for the applications programs. 
They are declared globally to facilitate debugging. #) 


d.dalpha ,db ,dbeta,deltx, deity ,delz,di3t,dp, 
dphi ,dpsi ,dq,dr ,dtheta,du,g,h,i ,k,l ,p, 
ps i apr , r , r es , t , t ad , thrsho , thrus t , 
x ,x2 ,y ,y2 , ttim: integer; 

(* The following exist to circumvent an "optimization" in the 
compiler. *) 

c2,c4,c8,c1024: integer; 

PROCEDURE BROADCAST(B:BUFFER ) ; EXTERN; 

PROCEDURE STOBROADCAST(B: BUFFER; V: INTEGER); EXTERN; 

PROCEDURE WAITBROADCAST ; EXTERN; 

FUNCTION GETVOTE(Qs BUFFER ): INTEGER;EXTERN ; 

FUNCTION MEDIAN (Q:BUFFER)s INTEGER; EXTERN; 

( * these fellows perform scaling operations and are found in module applmd 

where md :«• a*b/c; 

and mdii : = a*b/2**ii; *) 

FUNCTION MD ( A, B,C: INTEGER): INTEGER; EXTERN; 

FUNCTION MD1 4( A , B: INTEGER ): INTEGER; EXTERN; 

FUNCTION MD1 2( A, B: INTEGER ) :INTEGER; EXTERN; 

FUNCTION MD1 1 (A, B: INTEGER): INTEGER; EXTERN; 

FUNCTION MD10(A,B:INTEGER):INTEGER; EXTERN; 

FUNCTION MD9 ( A , B : INTEGER ) : INTEGER ; EXTERN; 

FUNCTION MD8 ( A, B: INTEGER): INTEGER; EXTERN; 

FUNCTION MD6 ( A, B: INTEGER): INTEGER; EXTERN; 

FUNCTION MD2( A , B : INTEGER ) : INTEGER ; EXTERN; 


Page 57 


27-JUN-85 The SIFT Hardware/Software Systems - Volume II 

Software Listings 


(********** jcos *#*###***#) 

FUNCTION I COS (X: INTEGER): INTEGER; 

(* isin and icos accept arguments in the range -25736 to 25736 
which is pi/2 * 2**14. values of isin and icos range from 
-16384 to +1 6384, that is, 2**14 corresponds to real value 1.0 
if called with an argument outside the correct range, say 30000 
the functions return values of poor accuracy. *) 

var i,y: integer; 

begin 

if x<0 then x:*-x; 
if x>24575 then icos:*25736-x 
else 
begin 

i := 1 + x div C1024; y : =* v [i ] ; 
deity :* y - v[i+1]; deltx 1024; 
t ad : *x- 1 02 4* ( i- 1 ) ; 

while (tad>=l80) or (delty>=*1 80) do 
begin 

deltx: =deltx div C2; deity: -deity div C2; 
if tad>deltx then 

begin y:=y-delty; tad: -tad~deltx end 

end; 

icos: =y- (tad* deity) div deltx 
end; 

end; (* ICOS *) 


(######*### ISIN *###*#*#**) 

FUNCTION ISIN (X: INTEGER): INTEGER; 
begin 

if x<0 then isin: =-icos(x+25736) 
else isin:=*icos(x-25736) 
end; (* ISIN *) 


(######*### ISQRT *#*##**#**) 

FUNCTION ISQRT(X: INTEGER): INTEGER; 

(* the isqrt function simply hands back a negative argument, 
otherwise it returns the correct value for all 1 6-bit inputs 
less than about 32500. *) 

var j , guess: integer; 

begin 

if x< = 1 then isqrt:-x 
else 
begin 

guess: =1 28 ; j : =1 ; 
while j<*7 do 

begin guess: = (guess+x div guess) div C2; j:=*j + 1 end; 
isqrt: =guess 
end 

end; (* ISQRT *) 
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(*««***»*** mls *********») 

GLOBAL FUNCTION MLS: INTEGER; 

(* This routine converts MLS data to x,y, and z. 

Localizer > 0 is fly right. Glideslope angle is always positive. *) 

begin 

d: -median (adi stance); d:«-d; g: -median (aglidesl ope); 
l:»median(alocalizer); dist:-md1 4(d,icos(g) ); 
stobroadcast(qx,md1 4(dist,icos(l) ) ); 
stobroadcast(qy ,md1 1 (dist,isin(l) ) ) ; 
s t obr oadcas t ( qz , md 1 0( d , i sin (g ) ) ) ; 
mis: -0 

end; (* MLS *) 
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(**«*«*»*** GUIDANCE #»»*«*****) 

GLOBAL FUNCTION GUI DANCE: INTEGER; 

(* This subroutine provides lateral GUI DAN for the aircraft. *) 

const rnav=1 ; intcpt=2; lclzr»3» 

begin 

h: =median(acmdhead) ; x:=getvote(qx); y: *getvote(qy) ; 
r:=median(aradius); p:=getvote(psin); 1 : -get vote ( olatmo ) ; 

if getvote(xreset)=1 then l:=rnav; 

psiapr:=h div C2; thrsho:=md 1 4(r, 1 6384-icbs(h) ); 
if h>0 then thrsho: =-thrsho; 

(# Perform mode switching logic and reset turn tinier clock. ») 

ttim: =getvote( timer); 
if p<0 then p:=-p; 
if (l=rnav) and (y>thrsho) then 
begin ttim:=0; l:=intcpt end; 
if (l=intcpt) and (p<82) then l:«lclzr; 
ttim: =ttim+1 ; 

stobroadcast ( timer , ttim ) ; 

(* Set nominal values according to mode. *) 

if l=rnav then 
begin 

s tobroadcas t(psin .psiapr ) ; 
stobroadcast (phin, 0) ; 
stobroadcast(rn,0) ; 
i : =psiapr*2; 

t: =md1 2(y-median(ay3) ,icos(i)); 
t:=(t-md9(x-median(ax3) ,isin(i)) )*2; 
stobroadcast(odely ,t); 
end 

else if l=intcpt then 
begin 

stobroadcast(psin,psiapr + md(ttim,median(arturn) ,320) ); 

(* the preceding constant was 800, but then i changed dt“.05 in dC3 
stobroadcast(phin,median(aphitrn) ); 
stobroadcast (rn ,median(arturn) ) ; 
t: =x-median(axcntr); 
x2:=md8(t,t); 
t: =y-median(aycntr ) ; 
y2 :=md1 4(t ,t) ; 
dist:=isqrt(x2+y2)*1 28; 
t:=(r-dist)*8; 
if psiapr>0 then t:=-t; 
stobroadcast (odely ,t) ; 
end 
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else if l=lclzr then 
begin 

stobroadcast(psin f O) ; 
stobroadcast (phin ,0) ; 
stobroadcast(rn,0) ; 
stobroadcast (odely ,y * 8) 
end; 

stobroadcast(olatmo,l ); 
gui dance :=0 

end; (* GUIDANCE *) 
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(********** LATERAL **********) 

GLOBAL FUNCTION LATERAL -.INTEGER; 

(* Lateral control. First, calculate deviations frcm nominal. *) 
begin 

dp: =median(ap) ; 

dr:=median(ar ) - getvote(rn); 

dbeta:=medi an (abet a); 

dpsi := median(apsi) - get vote (pain); 

dphi : =median (aphi ) - getvote(phin); 

(* dely is not modified *) 

(# calculate aileron. *) 

t:-md(-98,dp,400) + md(98,dr , 400) + md(-6,dbeta,8) ; 
t:-md(-130, dphi, 100) + (t div c2); 
stobroadcast(ocmdail , 

md(-6,getvote(odely) ,10) + md(- 102, dpsi, 200) + (t div C4)); 

(* Next the rudder. #) 
t:=md(8,dr ,10) + md( 126, dp, 400) ; 
t:=md(27,dbeta,20) + (t div C4); 

t:=md( 71 68,getvote(odely) ,4000) + ad(3,dphi,8) + (t div C4); 
t: = md (67, dpsi, 80) + (t div C4); 
stobroadcast(ocmdrud ,t ) ; 

later al:=0 

end; (* LATERAL *) 
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(#*###*##** PITCH *«**»****») 

GLOBAL FUNCTION PITCH : INTEGER; 

(* This subroutine controls the aircraft in pitch. *) 

const, armed-1 ; engaged=0; 

begin 

p: -getvote(opitmo); 
if getvote(xreset)-1 then p:-armed; 

if (median (agl ideal ope) >=858) and (p-armed) then p: -engaged; 

(* Calculate deviations from nominal when glideslope is armed. *) 
if pOengaged then 
begin 

dq:=median(aq); 

du:=median(au) ; 

dalpha: =median(aalpha) ; 

dtheta:*median(atheta); 

delz: =getvote(qz) + median(acmdalt); 

thrust: =0; 

end 

else (» Calculate deviations from nominal when glideslope is engaged *) 
begin 

dq:=median(aq); 
du:=median(au)+*»096; 
dalpha: =median(aalpha)-*1 678; 
dtheta:=median(atheta)+634; 

delz: =getvote(qz) + md(837,getvote(qx) ,1000) ; 

thrust:=-609 

end; 

(* Calculate elevator deflection and throttle command, 
first elevator: *) 

t:=md(-112,dq,200) + md2(5, dalpha) ; 
t:»(t div C 1 !) + md (31 1 3*delz,100); 

t: = (t div C4) + md(220,du,500) + md(-42,dtheta, *10) ; 

stobroadcast(ocmdele ,t div C2); 

(* then throttle: *) 

t:-md1 1 (245 ,dq) + mdl 1 (4739, dalpha); 

t : = ( t div C8) + md6(~107,du); 

t:-(t div C2) + md12(-*)058,dtheta); 

t: = ( t div C*0 + md2( 1 1 ,delz) + thrust; 

stobroadcast (odelz , delz ) ; 
s tobr oadcas t ( o cmdthr , t ) ; 
stobroadcast (opi tmo ,p ) ; 

pitch:-0 

end; (* PITCH *) 
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(**x«*»*»«» APPINIT *****»»**») 


GLOBAL PROCEDURE APPINIT; 
begin 

V[1]:«16384; v[2]s-16352j v[3] :-1 6256; v[4] :«1 6097; 
VC53 : “15875; v[6] : -1 5590; v[7] :-1 5245; v[8]:«1484l; 
v[9] : = 1 4378; v[10]:-13860; v[1 1]:-1 3287; v[1 2] s-1 2662; 
v[1 3] 1988; v[ 14]: -11 267; v[1 5] :-10502; v[1 6] :-9696; 
v[17]:-8852; v[18]:-7974; v[19]:-7064; v[20] :«61 27; 
vC21 ] s-5166; v[22]:-4l85; v[23]:-3188; v[24]:-2178; 
v[25]:-1159; 

c2:-2; c4:-4; c8:«8; c1024:«1024; 
end. (* APPINIT, SIFTAP *) 
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MODULE APPLMD.SR 


NAME APPLMD 

# 

TITLE SIFT: Multiple precision Multiply/Divide 

# 

* These routines provide scaling functions for SIFT's 

* applications routines 

* 

ENTRY MD,MD2 f MD6,MD8,MD9,MD1 0,MD1 1 ,MD12,MD1 4 

# 

* MD ( A*B)/ C 

* 

* MDn (A*B)/2**n 

* 

* FUNCTION MD(A,B,C: INTEGER ): INTEGER ; 

* 

# 


MD 

PUSHM 

0,3 

SAVE SOME REGISTERS 


TRA 

0,15 

POINT AT THE DISPLAY 


LOAD 

1 ,-7,0 

GET A 


LOAD 

2, -6,0 

GET B 


LOAD 

0,-5, 0 

GET C 

MDDO 

MPY 

2,1 

PERFORM THE MULTIPLICATION 


DIV 

2,0 

DIVIDE 


TRA 

12,3 

STORE RESULT 


POPM 

0,3 

RESTORE REGISTERS 

* 

RPS 

0 

AND RETURN 

# 

* 

FUNCTION MD2 ( A, B: INTEGER): INTEGER; 

* 

* 

MD2 : = 

( A*B) DIV 4; 


MD2 

PUSHM 

0,3 

SAVE SOME REGISTERS 


TRA 

0,15 

POINT AT THE DISPLAY 


LOAD 

1 ,"6,0 

GET A 


LOAD 

2, -5,0 

GET B 


LOAD 

0 , F4 

SET C TO 4 


JU 

MDDO 

GO DO IT 

F4 

# 

FIX 

4 


* 

# 

FUNCTION MD6 ( A, B: INTEGER): INTEGER; 

* 

# 

MD6:- 

( A*B) DIV 64; 


MD6 

PUSHM 

0,3 

SAVE SOME REGISTERS 


TRA 

0,15 

POINT AT THE DISPLAY 


LOAD 

1 ,-6,0 

GET A 


LOAD 

2, -5,0 

GET B 


LOAD 

0,F64 

SET C TO 64 


JU 

MDDO 

GO DO IT 

F64 

FIX 

64 
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* 


* FUNCTION MD8 ( A , B : INTEGER ) : INTEGER ; 

* 


# 

* 

MD8: = 

(A*B) DIV 

256; 


MD8 

PUSHM 

0,3 


SAVE SOME REGISTERS 


TRA 

0,15 


POINT AT THE DISPLAY 


LOAD 

1,-6,0 


GET A 


LOAD 

2, -5,0 


GET B 


LOAD 

0.F256 


SET C TO 256 


JU 

MDDO 



F256 

* 

FIX 

256 



# 

* 

FUNCTION MD9(A, 

B : INTEGER ) : INTEGER ; 

* 

* 

MD9 

( A*B) DIV 

512; 


MD9 

PUSHM 

0,3 


SAVE SOME REGISTERS 


TRA 

0,15 


POINT AT THE DISPLAY 


LOAD 

1 ,-6,0 


GET A 


LOAD 

2, -5,0 


GET B 


LOAD 

0.F512 


SET C TO 512 


JU 

MDDO 



F512 

* 

FIX 

512 



* 

# 

FUNCTION MD1 0( A 

B : INTEGER ) : INTEGER ; 

# 

# 

MD1 0: 

( A*B) DIV 

1024; 


MD1 0 

PUSHM 

0,3 


SAVE SOME REGISTERS 


TRA 

0,15 


POINT AT THE DISPLAY 


LOAD 

1 ,-6,0 


GET A 


LOAD 

2, "5,0 


GET B 


LOAD 

0, FI 024 


SET C TO 1024 


JU 

MDDO 


GO DO IT 

FI 024 

* 

FIX 

102 4 



* 

* 

FUNCTION MD1 1 (A 

,B:INTEGER): INTEGER; 

* 

# 

MD1 1 : 

= ( A*B) DIV 

2048; 


MD1 1 

PUSHM 

0,3 


SAVE SOME REGISTERS 


TRA 

0,15 


POINT AT THE DISPLAY 


LOAD 

1 ,-6,0 


GET A 


LOAD 

2, -5,0 


GET B 


LOAD 

0.F2048 


SET C TO 2048 


JU 

MDDO 


GO DO IT 

F2048 

FIX 

2048 


m 
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FUNCTION MD12(A,B:INTEGER):INTEGER; 
MD1 2:=(A*B) DIV 4096; 


MD1 2 

PUSHM 

0.3 

SAVE SOME REGISTERS 


TRA 

0,15 

POINT AT THE DISPLAY 


LOAD 

1.-6.0 

GET A 


LOAD 

2,-5, 0 

GE T B 


LOAD 

0.F4096 

SET C TO 4096 


JU 

MDDO 

GO DO IT 

F4096 

* 

FIX 

4096 


* 

# 

FUNCTION MD1 4( A , B : INTEGER ) : INTEGER ; 

* 

# 

MD1 4: = 

(A*B) DIV 16384; 


MD1 4 

PUSHM 

0,3 

SAVE SOME REGISTERS 


TRA 

0,15 

POINT AT THE DISPLAY 


LOAD 

1 ,"6,0 

GET A 


LOAD 

2, -5,0 

GET B 


LOAD 

0, FI 638 

SET C TO 16384 


JU 

MDDO 

GO DO IT 

FI 638 

FIX 

16384 



* 


END 
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